<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">use strict;
use DBI;
use CGI;
use HTML::Template::Pro;
use Crypt::CBC;
use Storable qw/freeze thaw/;
use Data::Dumper;

our($dbh, $q, $curruser);
our(%rootlvl, %userlvl);

eval{
  main();
};
if($@){
 warn $@;
}

sub dnice{
 print "Content-type: text/html\n\n";
 my($msg) = @_;
 print $msg;
 die @_;
}

sub main{
  #$dbh ||= DBI-&gt;connect('...','','',{RaiseError =&gt; 1, AutoCommit =&gt; 0});
  $q = new CGI;
  checkuser();

  my $action;
  $action = $q-&gt;param('action') || $q-&gt;param('action','index');
  dnice('No such action') if $action !~ /^(\w+)$/;
  $action = 'ext_' . $1;
  my($hdrs, $result, $noncacheable);

  dnice 'No access' if !accessallowed($action, $curruser);

  eval{
    ($hdrs, $result, $noncacheable) = __PACKAGE__-&gt;$action;
  };
  dnice($@) if $@;

  print $q-&gt;header( -type =&gt; 'text/html',
                    -charset =&gt; 'cp1251',
		    @$hdrs);
  !$result &amp;&amp; return;
  !ref $result &amp;&amp; print($result) &amp;&amp; return;
  
  my $tmpl = HTML::Template::Pro-&gt;new( filename          =&gt; $q-&gt;param('action') . '.tmpl',
				       path              =&gt; './tmpl',
				       associate         =&gt; $q,
				       loop_context_vars =&gt; 1,
				       global_vars       =&gt; 1
				       );
  $tmpl-&gt;param(@$result);
  print $tmpl-&gt;output();
}

#просто выводим страницу
sub ext_example{
 return [], [ dummy=&gt; 1 ];
}

#делаем редирект
sub ext_example_redirect{
 return [ -location =&gt; 'http://www.lala.com' ];
}

#вместо запрошенного action делаем другой - н., засабмитили некорректно заполненную форму, надо бы ее еще раз вывести
sub ext_example_substitute{
  $q-&gt;param('action', 'example');
  return ext_example();
}

#а вдруг нам надо вернуть картинку?
sub ext_example_plain{
 return [ -content_type =&gt; 'application/octet-stream' ], 'plain octet-stream';
}
#######################################################
sub checkuser{
 return 1;
}
sub accessallowed{
 return 1;
}</pre></body></html>