package ACIS::Common;

use strict;

require Exporter;

use Carp::Assert;

use vars qw( @ISA @EXPORT $LOGFILENAME $LOGCONTENTS );

@ISA = qw( Exporter );

@EXPORT = qw ( &log_error &log_warn &log_msg &log_info
               &critical &debug &eval_wrap &generate_id
               &force_dir );

$LOGCONTENTS = '';

my $eval_count = 0;

sub critical_message
 {
  my $msg = shift;

  my @lines = split /\s*\n/, $msg;

  if( scalar @lines ) {
    $msg = shift @lines;
  }

  print "<h1>Internal Error</h1>".
   "<p>Problem: $msg</p>\n";

  if( scalar @lines ) {
    print "<ul>\n";
    foreach ( @lines ) {
      print "<li>$_</li>\n";
    }
    print "</ul>\n";
  }

  print "<p>Debug information:</p>\n<pre>$LOGCONTENTS</pre>"
   unless $ACIS::DEBUGIMMEDIATELY;
  
 }

sub log_info;

sub eval_wrap {
  my $code = shift;
  my $name = shift;

  my ($package, $filename, $line, $subroutine, $hasargs,
    $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1);
  ($package, $filename, $line) = caller;

  log_info "evaling $name no. $eval_count: '$code' at $subroutine($line)";

  $eval_count ++;

  eval $code;
}


sub generate_id
 {
  my $limit = 0xffffffff; # 32 bit - 8 chars string (each char - 4 bit, 0-f)
                      # 16 bit division for win32 systems, perl unexpected rand only 16bit
  return sprintf "%08x", $limit ^ rand ($limit);
 }
 
sub debug
 {
  return
    unless $ACIS::DEBUG;
  my $message   = join '', @_;
  
  my ($package, $filename, $line, $subroutine, $hasargs,
     $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1);
  ($package, $filename, $line) = caller;
  

#  warn "[$subroutine($line)] $message\n";
#  if $ACIS::DEBUGIMMEDIATELY;
  print "[$subroutine($line)] $message"
# , "<br>"
    if $ACIS::DEBUGIMMEDIATELY
;

  $LOGCONTENTS .= "[$subroutine($line)] $message\n";

 }

sub log_error
 {
  my $message  = shift;
  log_msg ( 'error', $message );
 }

sub log_info
 {
  my $message  = shift;
  log_msg ( 'info', $message );
 }

sub log_warn
 {
  my $message  = shift;
  log_msg ( 'warn', $message );
 }

sub log_msg
 {
  my $type    = shift;
  my $message = shift;

  my $log_file = $ACIS::Common::LOGFILENAME;

#  $log_file =~ s/\/\//\//g;
  my $timestring = scalar localtime;
  
  my ($package, $filename, $line, $subroutine, $hasargs,
   $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1);
  ($package, $filename, $line) = caller;
  
  $LOGCONTENTS .= "[$subroutine($line)] [$type] $message\n";
  
  if ( not defined $log_file )
   {
    print "[", $timestring, "] [$type] $message\n";
   }
  else
   {
    open  LOG, ">> $log_file" ;
    print LOG "[", $timestring, "] [$type] $message\n";
    print "\n[", $timestring, "] [$type] $message\n"
      if $ACIS::LOGPRINT;
    close LOG ;
  }
}


sub critical
 {
  my $message  = join '', @_ ;
  my $log_file = $ACIS::Common::LOGFILENAME;

  if ( defined $log_file ) {
    open  LOG, ">> $log_file" ;
    print LOG "[", scalar localtime, "] [critical] $message\n";
    close LOG ;  
  } 

  my ($package, $filename, $line, $subroutine, $hasargs,
    $wantarray, $evaltext, $is_require, $hints, $bitmask) = caller(1);
  ($package, $filename, $line) = caller;
  
  $LOGCONTENTS .= "[$subroutine($line)] [critical] $message\n";
  die "[$subroutine($line)] [critical] $message\n";
 }


sub force_dir
 {
  my $base = shift;
  my $dir  = shift;
  
  $base =~ s+/$++g;
  $dir  =~ s+^/|/$++g;
  
  my @dirs = split '/', $dir;
  
  foreach (@dirs)
   {
    $base .= '/' . $_;
    mkdir $base or critical "can't create '$base' dir"
     unless -d $base;
   }
 }


1;



# Below is stub documentation for the module

# object oriented

sub info {
  my $class = shift;
  &log_info ( join '', @_ )
}

sub error {
  my $class = shift;
  &log_error ( join '', @_ )
}

sub warning {
  my $class = shift;
  &log_warn ( join '', @_ )
}

