view release on metacpan or  search on metacpan

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

    }
    else {
       if ($opt !~/h/ && $_[0] =~/cacls/) { # !!! IIS/cacls behaviour debug
          $r  =join(' ',@_,'2>&1');
          @$o =`$r`;
        # push @$o, Win32::LoginName, `logname`; # 'SYSTEM'/'IUSR_' || 'IUSR_'/'IWAM'
       }
       else {
          system(@_)
       }
    }
 }
 else {
    eval('use IPC::Open2');
    my $pid = IPC::Open2::open2(\*RDRFH, \*WTRFH, @_); 
    if ($pid) {
       if ($sub) {
          my $select =select();
          select(WTRFH);
          $| =1;
          &$sub($s);
          select($select);
       }
       @$o =<RDRFH>;
       waitpid($pid,0);
    }
 }
 $r =$?>>8;
 $s->pushmsg(@$o) if $o && $opt !~/h/;
 $s->die(join(' ',@_) .($opt !~/h/ ? '' : ' -> ' .join('',@{$o||[]})) ." -> $r\n") if $r && $opt !~/i/;
 !$r
}



#######################


sub httpheader {
 my $s =shift;
 my %p =!defined($_[0]) ? () : @_==1 && ref($_[0]) ? %{$_[0]} : @_;
 if (ref($s->{-httpheader})) {
    foreach my $k (keys(%{$s->{-httpheader}})) {
      if (!exists($p{$k})) {$p{$k} =$s->{-httpheader}->{$k}}
    }
 }
 $s->{-cgi}->header(%p)
}


sub htmlstart {
 my $s =shift;
 my %p =!defined($_[0]) ? () : @_==1 && ref($_[0]) ? %{$_[0]} : @_;
 if (ref($s->{-htmlstart})) {
    foreach my $k (keys(%{$s->{-htmlstart}})) {
      if (!exists($p{$k})) {$p{$k} =$s->{-htmlstart}->{$k}}
    }
 }
 $p{-style} ={code=>
	".Form, .List, .Help, .MenuArea, .FooterArea {margin-top:0px; font-size: 8pt; font-family: Verdana, Helvetica, Arial, sans-serif; }\n"
	#."a:link.ListTable {font-weight: bold}\n"
	.".MenuButton {background-color: buttonface; color: black; text-decoration: none; font-size: 7pt;}\n"
	#."td.MenuButton {background-color: activeborder;}\n"
	#.".MenuArea {background-color: blue; color: white;}"
	#.".MenuButton {background-color: blue; color: white; text-decoration: none; font-size: 7pt;}\n"
	.".PaneLeft, .PaneForm, .PaneList {margin-top:0px; font-size: 8pt; font-family: Verdana, Helvetica, Arial, sans-serif; }\n"
	."td.ListTable {border-style: inset; border-bottom-width: 1px; border-top-width: 0px; border-left-width: 0px; border-right-width: 0px; padding-top: 0;}\n"
	."th.ListTable {border-style: inset; border-bottom-width: 1px; border-top-width: 0px; border-left-width: 0px; border-right-width: 0px;}\n"
	} if !exists($p{-style});
 $s->{-debug} && $s->{-debug} >2
 ? $s->{-cgi}->start_html(%p)
  .("\n<!-- " .$s->{-cgi}->escapeHTML($s->microenv) ." -->\n")
 : $s->{-cgi}->start_html(%p) 
}


sub htmlend {
 $_[0]->microtest if $_[0]->{-debug} && $_[0]->{-debug} >3;
 $_[0]->{-cgi}->end_html
}


sub htpgstart {
  $_[0]->httpheader($_[1])
 .$_[0]->htmlstart($_[2])
 .($_[0]->{-htpgtop}||'')
}


sub htpgend {
  ($_[0]->{-htpgbot}||'')
 .$_[0]->htmlend
}


sub htpfstart {
 my $s =shift;
 $s->htpgstart($_[0],$_[1]) ."\n" 
 .((($ENV{HTTP_USER_AGENT} ||'') =~m{^[^/]+/(\d)} ? $1 >=3 : 0)
  ? $s->{-cgi}->start_multipart_form({-action=>$s->url_form()
		, -acceptcharset=>$s->{-httpheader} ?$s->{-httpheader}->{-charset} :undef
		, $_[2] ? %{$_[2]} : ()
		})
  : $s->{-cgi}->start_form({-action=>$s->url_form()
		, -acceptcharset=>$s->{-httpheader} ?$s->{-httpheader}->{-charset} :undef}
		, $_[2] ? %{$_[2]} : ()
		)
  ) ."\n"
}


sub htpfend {
 "\n</form>\n" .$_[0]->htpgend(@_)
}


sub htmlescape {
 !defined($_[1]) ? '' : shift->{-cgi}->escapeHTML(@_)
}