package ACIS::Web;

use strict;
use warnings;

use Carp qw( verbose );
use Carp::Assert;

use Data::Dumper;
use Storable;

use Encode;

use CGI;
use CGI::Carp qw( fatalsToBrowser set_message carpout );
use CGI::Untaint;

use XML::LibXML;
use XML::LibXSLT;

use sql_helper;

use ACIS::Data::DumpXML qw(dump_xml);
use ACIS::Common;

use ACIS::Web::Config;
use ACIS::Web::Session;
use ACIS::Web::UserData;

use ACIS::Web::Services;



BEGIN {  set_message( \&ACIS::Common::critical_message );  }; 



sub new {
  my $class   = shift;
  my $params  = {@_};
  my $home    = $params -> {'home'};
  
  my $config_file = $params -> {'config'} || 'acis.conf';
  my $screen_file = $params -> {'screen-config'} || 'screens.xml';
  
  #- Анализирует входящий запрос, производит общую абстрактную обработку запроса
  
  $home = $ACIS::LocalConfig::local_path
   unless (defined $home);
  
  debug "creating ACIS::Web object in $home";
  
  my $self    =   {
    'config-file' => $config_file,
    'screen-file' => $screen_file,
    'home'        => $home,
    'session'     => undef,
    'sessionfile' => undef,
    'variables'   => {},
    'username'    => undef,
  };
  
  bless $self, $class;
  
  debug 'loading configuration';
  
  $self -> config;
  
  my $config = $self->{config};


  my $template_set = $config -> {'template-set'};
  my $shared       = $config -> {'static-base-dir'};
  my $static       = $config -> {'static-base-url'};
  
  my $paths = {
    'home'        => $home,
    'shared'      => $shared,
    'static'      => $static,
    'presenters'  => "$home/presentation/$template_set",
    'log'         => "$home/acis.log",
    'errlog'      => "$home/acis-err.log",
  };
  

  $self -> {paths} = $paths;
  

  my $data = $self -> {'presenter-data'} =  {

    system => {
      config => {
        debug        => $ACIS::DEBUG,
      },

#      'debug-messages' => '',
    },

    request => {
    },

    response => {
      data    => $self -> {variables},
    },
  };


  ###  copy some of the configuration parameters into
  ###  $presenter-data/system/config
  {
    my @config_params_copy =
      qw( base-url site-name site-name-long admin-email 
	  system-email css-url institutions-maintainer-email
	  problem-report-url );

    my $data_conf = $data -> {system} {config};

    foreach ( @config_params_copy ) {
      $data_conf -> {$_} = $config -> {$_};
    }

    $data_conf-> {home} = $home;
  }

  return $self;
}


##############################################################
### некоторое количество функций немного облегчающих жизнь ###
##############################################################

sub error {
  my $self = shift;
  my $error_id = shift;

  if( $error_id ) {
    $self -> {'presenter-data'} {response} {error} = $error_id;
  } else {
    return $self -> {'presenter-data'} {response} {error};
  }
}


sub message {
  my $self = shift;
  my $message_id = shift;

  if( $message_id ) {
    $self -> {'presenter-data'} {response} {message} = $message_id;
  } else {
    return $self -> {'presenter-data'} {response} {message};
  }
}


sub success {
  my $self = shift;
  my $success = shift;

  $self -> {'presenter-data'} {response} {success} = $success;
}


sub config {
  my $self = shift;

  my $par  = shift;
  if( defined $par ) {
    return $self ->{config} ->{$par};
  }
  
  return $self -> {config}
      if $self -> {config};
  
  my $home = $self -> {home};

  my $config_file = $home . '/' . $self -> {'config-file'};

  if ( not -f $config_file ) {
    die "Can't read ACIS config from file $config_file";
  }

  my $screen_file = $home . '/' . $self -> {'screen-file'};
  
  my $config_object;
  
  my $bin_config_file = $config_file . '.binary';
  
  debug "compare timestamps of the config file '$config_file', "
    . "its binary dump '$bin_config_file' and module ACIS::Web::Config";

  my $configuration_package_file = $INC {'ACIS/Web/Config.pm'};

  
  my $package_change = -M $configuration_package_file;
  my $config_change  = -M $config_file;
  my $screen_change  = -M $screen_file;
  my $binary_change  = -M $bin_config_file
   if -f $bin_config_file;
  
  my $last_modified = $config_change;
  my $action = 'parse';

  assert( defined $package_change );
  assert( defined $config_change );
  
  
  if ($package_change < $config_change)
   {
    debug "module are newer than configuration";
    $last_modified = $package_change;
    $action = 'parse';
   }
  
  if ($screen_change < $last_modified)
   {
    debug "screen configuration changes are newer than configuration";
    $last_modified = $screen_change;
    $action = 'parse';
   }
  
  if ( (-f $bin_config_file) and ($binary_change < $last_modified) )
   {
    debug "configuration binary newer than new";
    $action = 'restore';
   }
  
  if ($action eq 'parse')
   {
    debug 'parsing configuration';
    
    $config_object = retrieve ACIS::Web::Config ($home, $config_file, $screen_file)
     || critical "ACIS::Web::Config did not work";

    store ( $config_object, $bin_config_file )
     or log_error ( "cannot write binary config to '$bin_config_file'" );
   }
  elsif ($action eq 'restore')
   {
    debug "loading configuration binary" ;
    $config_object = retrieve ( $bin_config_file );
   }
  
  critical 'something wrong in configuration'
   unless defined $config_object and $config_object;
  
  $self -> {'config'} = $config_object;
  
  foreach my $module (@{$config_object -> {'modules'}})
   {
    debug "try using $module";
    eval "use $module;";
    critical $@ if $@;
   }
  
  return $self -> {'config'};
}


sub paths { 
  my $self = shift;
  
  if ( $_[0] ) {
    my $par = shift;
    return $self ->{paths} -> {$par};
  }

  return $self -> {paths};
}



sub request {
  my $self = shift;
  return $self -> {request};
}


sub variables {
  my $self = shift;
  return $self -> {variables};
}


sub user_data {

  my $self = shift;
  my $path = shift;
  
  unless ( defined $self -> {'user-data'} ) {

    unless ( $path ) {
      $path = $self -> paths -> {'user-data'};
    
      critical "authorization required"
	unless defined $path and $path;
    }

    assert( $path !~ m!//! );
     
    my $user_data = load ACIS::Web::UserData ($path);
    $self -> {'user-data'} = $user_data;
  }
  
  return $self -> {'user-data'};
}



sub update_paths_for_login {
  my $self  = shift;
  my $login = shift;

  assert( $login );

  my $homedir = $self ->{home};


  my $word_login = lc $login;
  $word_login =~ s/[^a-z0-9]//g;
  
  my ( $fl, $sl ) = unpack( 'aa', $word_login );
  
  my $udata_dir = $homedir . "/userdata";

  my $base = "$udata_dir/$fl/$sl/$login";

  my $udata_file = "$base.xml";
  my $udata_lock = "$base.lock";


  ### update paths

  my $paths = $self ->{paths};

  $paths -> { 'user-data'      } = $udata_file;
  $paths -> { 'user-data-old'  } = $udata_file;
  $paths -> { 'user-data-lock' } = $udata_lock;


  my $deleted = "${homedir}/deleted-userdata/${login}.xml"; 
  
  $paths -> { 'user-data-deleted' } = $deleted; 
  

  if( not -f $udata_file ) {
    force_dir ( $udata_dir, "$fl/$sl");
  }
 
  return $paths;
}



sub userdata_file_for_login {
  my $self  = shift;
  my $login = shift;

  assert( $login );

  my $homedir = $self ->{home};


  my $word_login = lc $login;
  $word_login =~ s/[^a-z0-9]//g;
  
  my ( $fl, $sl ) = unpack( 'aa', $word_login );
  
  my $udata_dir = $homedir . "/userdata";

  my $udata_file = "$udata_dir/$fl/$sl/$login.xml";

  if( not -f $udata_file ) {
    force_dir ( $udata_dir, "$fl/$sl");
  }

  return $udata_file;
}


 
sub session {
  my $self = shift;
  
  my $session    = shift;
  my $recalculate = shift;  ### XXX remove

  assert not $recalculate;  ### because not implemented

  if( defined $session ) {

    if( $self->{session} ) {
      assert( $session == $self->{session} );
    } else {
      assert( not ( $self->{session} ), "overwriting a session in ACIS::Web object?" );
    }

#    ### XXX DEBUG and testing
#    $session -> {'.lifetime'} = 300;


    $self -> {session} = $session;
    $self -> update_paths();


    my $prequest =  $self -> {'presenter-data'} -> {'request'};

    $prequest -> {session} =  {
       'id'   => $session -> id,
       'type' => $session -> type,
    };
    
    $prequest -> {user}    = $session -> owner;

    $self -> set_username( $session-> owner -> {login} );

    my $record = $session -> current_record;
  
    if( $record ) {

      my $cur_rec = {
		     'id'   => $record -> {'id'},
		     'name' => $record -> {'full-name'},
		     'type' => $record -> {'type'},
		    };

      $prequest -> {session} -> {'current-record'} = $cur_rec;

      if( $record->{"about-owner"} ) {
	$cur_rec ->{'about-owner'} = $record ->{'about-owner'};
      }

    }

    return $session;
  }

  return $self -> {session};
}




sub sql_object {
  my $self = shift;
  
  return $self -> {'sql-object'}
   if defined $self -> {'sql-object'};

  sql_helper -> set_log_filename ( $self ->{home} . '/sql.log' );

  my $config = $self -> config;

  $self -> {'sql-object'} = sql_helper ->
   new( $config -> {'db-name'}, $config -> {'db-user'}, $config -> {'db-pass'} )
    or return undef;
  
  return $self -> {'sql-object'};
}




sub update_paths {

  my $self = shift;
  
  my $paths   = $self -> {paths};

  if ( defined $self -> {session} ) {

    my $session = $self -> session;
    my $home    = $self -> {home};
    

    my $login    = $session ->owner ->{login};
    my $oldlogin = $session ->owner ->{'old-login'};

    $self -> update_paths_for_login( $login );

    if( $oldlogin ) {
      my $old_userdata_file = $self ->userdata_file_for_login( $oldlogin );
      my ( $old_uprefix ) = ( $old_userdata_file =~ /(.+)\.xml$/ );
      
      $paths -> {'user-data-lock'} = "$old_uprefix.lock";
      $paths -> {'user-data-old' } = $old_userdata_file;
      
    } # if $oldlogin
    

    ### current-record-specific paths

    my $record_no = $session -> {'current-record-number'};
    my $record    = $session -> current_record;

    if ( defined $record_no
	 and $record->{type} eq 'person'
	 and not defined $paths -> {'personal-path'} 
	 and $record -> {'short-id'}
       ) {

      my $shared = $paths -> {'shared'};
      my $static = $paths -> {'static'};
      my $sid    = $record -> {'short-id'};

      assert( $sid );
    
      $paths -> {'personal-path'}  = "$shared/$sid.",
      $paths -> {'personal-url'}   = "$static/$sid.",
      
    }
    
  } 

  return $paths;
}



sub set_username {
  my $self = shift;
  my $username = shift;
  assert( $username );
  $self -> {username} = $username;
  debug "username: $username";
}



sub clear_after_request {
  my $self = shift;

  foreach ( qw( request username variables session user-data ) ) {
    $self -> {$_}   = undef;
  }
  
  my $paths = $self -> {paths};
  
  foreach ( qw( personal-path session user-data personal-url user-data-lock user-data-old ) ) {
    delete $paths -> {$_};
  }

  delete $self->{'presenter-data'} {request} {session};
  delete $self->{'presenter-data'} {request} {user};
  
}


#######################################################
########     h a n d l e    r e q u e s t     #########



sub handle_request {

  my $self = shift;

  
  #- используя конфигурацию (ACIS::Web::Config), находит соответствующий список
  #  обработчиков.
  
  my $config  = $self ->{config};
  my $homedir = $config ->{home};
  my $paths   = $self ->{paths};

  my $base_url = $config ->{'base-url'};

  ###  primary request analysis

  debug "fetch request data";
  
  my $query = new CGI;
  
  my $unescaped_url = $ENV{REQUEST_URI};
  $unescaped_url =~ s/%(\w\w)/chr(hex($1))/eg;
  
  my $requested_url = "http://$ENV{HTTP_HOST}$unescaped_url";
   
  my ($acis_request) = ($requested_url =~ /^$base_url\/?(.*?)(?=\?|\/?$)/);
  
  $acis_request = ''
   unless defined $acis_request;

  warn "handling request: $acis_request\n";

  debug "processing url: $requested_url, base url: $base_url, difference: $acis_request";
  
  my ($screen_name, $session_id) = split '!', $acis_request;

  $screen_name = 'index'
     unless ($screen_name);
  
  debug "this is request for screen: $screen_name";


  if( defined $session_id ) {
    debug "request of session: $session_id";

    $paths ->{session}     = "$homedir/sessions/$session_id";
    $paths ->{unconfirmed} = "$homedir/unconfirmed/$session_id.xml";

  } else {
    delete $paths->{session}; 
    delete $paths->{unconfirmed}; 
  }


  my @par_names = $query -> param;

  my $form_input =   
    $self -> {'presenter-data'} -> {request}
      ->{form} ->{input} = {};

  foreach ( @par_names ) {
    my @val = $query -> param( $_ );
    foreach( @val ) {
      $_ = Encode::decode_utf8( $_ );
      $_ =~ s/(^\s+|\s+$)//g;  ### XXX SPACE NORMALIZATION, might be questionable in some situations
    }
    if( scalar( @val ) == 1 ) {
      $form_input ->{$_} = $val[0];
    } else {
      $form_input ->{$_} = \@val;
    }
  }

  debug Dumper $form_input;

   
  $self -> {'request'} =
   {
    'CGI'        => $query,
    'params'     => $form_input,
    'screen'     => $screen_name,
    'session-id' => $session_id,
   };
  


  unless (defined $self -> config -> screen ($screen_name))
   {
    $screen_name = 'sorry';
    $self -> error ('screen-not-found');
   }
  
  $self -> {'presenter-data'} -> {'request'} -> {'screen'} = $screen_name;
  
  $self -> add_to_process_queue ($screen_name);
  $self -> set_presenter ($screen_name);
  
  #- передает управление первому обработчику из списка обработчиков для этого
  
  while (my $processor = $self -> next_processor)
   {
    debug "launch '$processor'";
    
    no strict;
    &$processor ($self);
   }
  
  debug "processors finished";


  my $session = $self -> session;
  
  if ( $session ) {
    $session -> save();
    debug "session saved";
  }


  my $location = $self->{'redirect-to'};
  
  if ($location)
   {
    $ACIS::DEBUGIMMEDIATELY
                 ? print "Location: <a href='$location'>$location</a>\n\n" :
                   print "Location: $location\n\n";
    return;
   }
  
  my $vars_xml_dumped = dump_xml ( $self ->{'presenter-data'} );



  my $content;


  ###  run main presenter

  my $presenter = $self ->{presenter};

  debug "presenter: " . $presenter->{type} . " in " . $presenter->{file};

#  if( 0 ) {
  if( $presenter->{type} eq 'xslt' ) {
    $content = $self -> run_presenter( $presenter ->{file}, 1 );


  } else {
    ### XXX simplify!
    my $file = "$paths->{presenters}/$presenter->{file}";
    $content =  launch_presenter (
				  $presenter -> {type},
				  $vars_xml_dumped,
				  $file );
  }


#  assert( Encode::is_utf8( $content ) ); ## XXX SANITY
    
  print '</pre>'
   if $ACIS::DEBUGIMMEDIATELY;
  


  ### iku: add debuggings content

  if( 1 ) {
#  if( 0 ) {

    my $debug_mark = '<!-- debuggings go here -->';
    if( $content =~ /$debug_mark/ ) {
      
      my $log =  $ACIS::Common::LOGCONTENTS;


      my $debuggings = <<_DEBUG_INCLUDE;

   <p>&nbsp;</p>
      
   <p><a title='this will be removed in production setting' 
   href='#debug' 
   onclick='javascript:document.getElementById("debug").style.display="block";'
   >Show debug info</a></p>

   <div class='debug' id='debug' style='display:none'>

     <p>Debug messages:</p>
     
     <textarea cols='110' rows='30' style='font-size: 12px;'>$log</textarea>
     
     <p>Presenter's data:</p>
     
     <textarea cols='110' rows='40' style='font-size: 12px;'>$vars_xml_dumped</textarea>

   </div>

_DEBUG_INCLUDE

      my $mark = $debug_mark;

#      Encode::_utf8_off( $mark );
#      Encode::_utf8_off( $debuggings );

      $content =~ s/$mark/$mark$debuggings/;
    }
  }

#  assert( Encode::is_utf8( $content ) ); ## XXX SANITY  


#  use encoding 'utf8';

  binmode STDOUT, ":utf8"; $/=undef;

  ###  now go, print the resulting page
  ###  XXX no-cache directive should be here?
  print "Content-Type: text/html; charset=UTF-8\n\n";


#  $content = Encode::encode_utf8( $content );
#  Encode::_utf8_on( $content );
#  assert( Encode::is_utf8( $content ) ); ## XXX SANITY
  utf8::decode( $content );
#  Encode::_utf8_on( $content );
  
  print $content;

  

 }
####   e n d    o f    h a n d l e   r e q u e s t   s u b 



sub add_to_process_queue {
  my $self = shift;
  my $screen = shift;

  debug "add '$screen' screen to processor queue";

  my $processors;
  
  if ( keys %{ $self -> request -> {params} } ) {
    $processors = $self -> config -> screen ($screen) -> {'process-calls'};

  } else {
    $processors = $self -> config -> screen ($screen) -> {'init-calls'};
  }

  push @{ $self -> {'processors'} }, @$processors;

}


sub set_presenter {
  my $self = shift;
  my $screen = shift;

  assert( $self );
  assert( $screen );
  assert( $self-> config-> screen( $screen ) );
  
  $self ->{presenter} =
   $self ->config ->screen ($screen) -> {presentation};
   
}
 

sub clear_process_queue {
  my $self = shift;
  
  debug 'requested for clearing processor queue, processed';
  
  $self -> {'processors'} = [];
}


sub next_processor {
  my $self = shift;
  
  return shift @{ $self -> {processors} };
}


sub redirect_to_screen {
  my $self   = shift;
  my $screen = shift;
  
  my $base_url = $self -> {config} -> {'base-url'};

  if ( $self->session ) {
    my $session_id = $self -> session -> id;
    $self -> {'redirect-to'} = "$base_url/$screen!$session_id";

  } else {
    $self -> {'redirect-to'} = "$base_url/$screen";

  }
  

}



sub redirect {
  my $self = shift;
  my $url  = shift;
  
  $self -> {'redirect-to'} = $url;
}



sub launch_presenter {  ### XXX deprecated

  my $type = shift;
  my $data = shift;
  my $file = shift;


  my ( $homedir ) = ( $file =~ /(.+)\/presentation\// );

  assert( $homedir, "file was: $file" );

#  Encode::_utf8_off( $data );

  ### XXX DEBUG 
  open FILE, ">:utf8", "$homedir/presenter_data.xml";
  print FILE $data;
  close FILE;

  warn "presenter: $file\n";

  
  my $result;
  
  my $error = '';
  my $msg = '';
  
  debug "applying stylesheet when needed and generate page content";
  
  unless (-f $file)
   {
    debug "we can't load file stylesheet '$file'";
    $error = 'found';
   }
  
  if ($type eq 'xslt' and not $error)
   {
    my $parser = new XML::LibXML;
    my $xslt   = new XML::LibXSLT;


    $parser -> expand_entities (0);
    $parser -> load_ext_dtd (0);
    

    assert( $data );
    my $xml;

#    Encode::_utf8_on( $data );
#    $xml = Encode::decode_utf8( $data );
    
    if( not $xml ) {
      $xml = $data; 
    }

    assert( $xml, "can't decode utf8 data" );

    ### XXX how to intercept libxslt output? 
    
 
    my $stylesheet;

    # parsing stylesheet
    eval {
      $stylesheet   = $xslt  -> parse_stylesheet_file( $file );
      assert( $stylesheet );
    };

    if ($@)
     {
      $error = 'parse';
      $msg = "<b>error:</b> $@\n<br />\nstylesheet: $file<br />\n<pre>$data</pre>\n<br>";
      goto ERROR;
     }

    # transformation
    my $result_object;
    eval {
      my $source = $parser -> parse_string ( $xml );
      assert( $source, "Can't parse source data" );
      $result_object = $stylesheet -> transform($source);
      $result = $stylesheet -> output_string( $result_object );
    };
    
    if ($@ or not $result_object or not $result )
     {
      $error = 'transform';
      $msg = "<b>error:</b> $@\n<br />\nstylesheet: $file<br />\n<pre>$data</pre>\n<br>";
      goto ERROR;
     }

   }
  elsif ($type eq 'static' and not $error)
   {
    open HTML_FILE, $file;
    local $/ = undef;
    $result = <HTML_FILE>;
    close HTML_FILE;
   }

  ### iku:
  if( not $error and 
      ( 
       not defined $result 
       or $result eq ''
       or $result =~ m!body></body! 
      ) ) {
    $error = "process data with";
    $msg = "Please let administrator know.  He should check server logs for LibXSLT output. Sorry!";
  }
  ### iku

  if ( $error )
   {

   ERROR:

    $result = qq[
    <html>
     <head><title>internal error</title></head>
     <body>

      <h1>Sorry!</h1>

      <h2>Internal error (in XSLT)</h2>

      <p>Cannot $error stylesheet '$file'.</p>

      <p>$msg</p>

     </body>
    </html>];
   }

  
  $result = pack( 'U*', unpack( 'U*', $result ) );

  # XXX DEBUG 
  open FILE, ">:utf8", "$homedir/presenter_result.xml";
  print FILE $result;
  close FILE;

#  assert( Encode::is_utf8( $result ) );

  return $result;
 }




### iku: 
sub run_presenter {

  my $self      = shift;
  my $presenter = shift;
  my $hide_emails = shift;

  assert( $presenter );

  my $homedir   = $self ->{home};
  assert( $homedir );

  my $paths          = $self -> paths;
  my $presenters_dir = $paths -> {presenters};

  my $data        = $self ->{'presenter-data'};

  my $data_string = dump_xml( $data );


  ### XXX DEBUG 
  open FILE, ">:utf8", "$homedir/presenter_data.xml";
  print FILE $data_string;
  close FILE;


  my $file = $presenters_dir . "/" . $presenter;
  
  warn "presenter: $file\n";

  
  my $result;
  
  my $error = '';
  my $msg   = '';
  
  debug "using stylesheet $file to generate some content";
  
  unless (-f $file) {
    debug "we can't find stylesheet file '$file'";
    $error = 'found';
  }
  

  my $parser = new XML::LibXML;
  my $xslt   = new XML::LibXSLT;

  $parser -> expand_entities (0);
  $parser -> load_ext_dtd (0);
    

  assert( $data_string );
  my $xml = $data_string;
  
 
  my $stylesheet;
  
  # parsing the stylesheet
  eval {
    $stylesheet   = $xslt  -> parse_stylesheet_file( $file );
    assert( $stylesheet );
  };

  if ($@) {
    $self -> errlog( "Can't parse xslt: $file ($@)" );
    die "Can't parse stylesheet: $file.  Please report to administrator: $@";
  }


  # transformation
  my $result_object;
  eval {
    my $source = $parser -> parse_string ( $xml );
    assert( $source, "Can't parse source data" );
    $result_object = $stylesheet -> transform($source);
    $result = $stylesheet -> output_string( $result_object );
  };
    

  if ($@ or not $result_object or not $result ) {
    $self -> errlog( "xslt transformation error, stylesheet: $file ($@)" );
    die "Can't transform data with stylesheet: $file.  Please report to administrator: $@";
  }

  $result = Encode::decode_utf8( $result );


  if( not $error 
      and  ( 
	    not defined $result 
	    or $result eq ''
	    or $result =~ m!body></body! 
	   ) 
    ) {
    $self -> errlog( "xslt transformation result is empty: $file ($@)" );
    warn "presenter's transformation result is empty";
    debug "presenter's transformation result is empty";
    
  }


  if( $hide_emails ) {
    hide_emails( \$result );
  }

  # XXX DEBUG 
  open FILE, ">:utf8", "$homedir/presenter_result.xml";
  print FILE $result;
  close FILE;


  return $result;
}




sub log {
  my $self  = shift;
  my $message = join '', @_;

  my $file = $self -> {paths} {log};
  my $date = localtime time;

  open  LOG, ">>:utf8", $file;
  print LOG $date, " [$$] ", $message, "\n"; 
  close LOG;

#  debug "log: $message";
}



sub errlog {
  my $self  = shift;
  my $message = join '', @_;

  my $file = $self -> {paths} {errlog};
  my $date = localtime time;

  open  LOG, ">>:utf8", $file;
  print LOG $date, " [$$] ", $message, "\n"; 
  close LOG;

#  debug "err: $message";
}


sub userlog {
  my $self    = shift;
  my $message = join '', @_;

  my $user = $self->{username};
  assert( $user, "user name is not yet known to the ACIS::Web object" );
  $self-> log( "[$user] ", $message );
}



### anti-spam email hiding

sub hide_emails {
  my $ref  = shift;
  assert( ref $ref );

#  my $data = $$ref;
  
  my $i = $$ref =~ s/(\'mailto:|\"mailto:|>)([^\@\s]+)\@([^\@\s]+)(\'|\"|<)/$1$2&#x40;$3$4/g;
  
#  warn "emails hidden: $i\n";

}




# iku: (not used now)
sub xslt_debug {
  my $msg = join ( ', ', @_ );
  debug "[XSLT] $msg";
}


 
1;

__END__

=head1 NAME

ACIS::Web

=head1 SYNOPSIS

 use ACIS::Web;
 my $acis = new ACIS::Web ( 'home' => 't/acis-home' );

 $acis -> handle_request();

=head1 DESCRIPTION

основной модуль для работы с веб-интерфейсом ACIS.


This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut
