#$Id: Sessionco.pm,v 1.2 2004/03/09 20:34:26 zagap Exp $

package HTML::WebDAO::Sessionco;
use HTML::WebDAO::Base;
use CGI;
use MIME::Base64;
#use usession;
#@ISA="usession";
use base qw( HTML::WebDAO::Session );

use strict 'vars';
attributes qw (Cookie_name Realm Db_file);

sub Init{
#Parametrs is realm => [string] - for http auth
#		id =>[string] - name of cookie
#		db_file => [string] - path and filename
#
my ($self,$param)=@_;
$self->SUPER::Init($param);
Db_file $self $param->{db_file} ?$param->{db_file}:"/tmp/engstore.db";
Realm $self $param->{realm} ?$param->{realm}:"eng.zone";
my $id=$param->{id} ||"stored";
Cookie_name $self ({	-NAME=>"$id",
			-EXPIRES=>"+3M",
			-PATH=>"/",
			-VALUE=>"0"}
		);
set_header $self ("-TYPE","text\/html");
set_header $self ("-EXPIRES","-1d");
}

sub get_id {
my $self=shift;
my $coo=U_id $self;
return $coo if ($coo);
my $uspwd;
if (exists($ENV{"HTTP_AUTHORIZATION"}) && ($ENV{"HTTP_AUTHORIZATION"})) {
$uspwd=decode_base64((split (/\s+/,$ENV{"HTTP_AUTHORIZATION"}))[1]);
} else {
$self->set_header("-status",'401 Authorization Required');
$self->set_header("-WWW_Authenticate",'Basic realm="'.$self->Realm().'"');
print $self->print_header();
exit;
}
my $_cgi=$self->Cgi_obj();
$coo=$_cgi->cookie(($self->Cookie_name())->{-NAME});
unless ($coo) {
	$coo=time();
	U_id $self ($coo.$uspwd);
	}
$self->Cookie_name()->{-VALUE}=$coo;

my $new_coo=$_cgi->cookie($self->Cookie_name());
$self->set_header("-COOKIE",$new_coo);
return $coo.$uspwd;
}

sub unpack_engine_tree(){
my ($self,$par)=@_;
sub GetPar{
my $cim=shift;
my $Res={};
my $name;
my ($term,$end,$begin);
while ($cim=~m/(\w*[{=])/g) {
    $name=$1;  
    $term=substr($name,-1);
    chop($name);
    for ($term){ do {
    /\=/					&& do {
	$cim=~m/([\w\!]*)\;/g;#print $1,"\n";
	my $tr=$1;$tr=~tr/\!/\=/;
	$Res->{$name}=decode_base64($tr); 
							}
						||
    /\{/					&& do {
	$begin=pos $cim;
	my $flag=1;
	while ($cim=~m/([{}])/g){
	    $1=~/\{/ ? ++$flag : --$flag;
	     $end=pos $cim,last if ($flag==0);
	    	}
	$Res->{$name}=&GetPar(substr($cim,$begin, $end-$begin-1));
							}
    }}
}
return $Res;
}#(GetPar)
#Get tree for _set_vars 
my $ref_tree=&GetPar($$par);
return $ref_tree;
}#SetSession

sub load {
my $self=shift;
my $ref_par=shift;
my ($id,$eng_name)=@$ref_par{"id","eng_name"};
my $temp;
my ($rec,$key,$eng,$val);
if (open FH,"<".$self->Db_file){
	while ($rec=<FH>){
	    ($rec=~/^(.*)\.\|\.(.*)\.\|\.(.*)$/) 
		&& (($key,$eng,$val)=($1,$2,$3))   
		&& ($key=~/$id/)
		&& ($eng=~/$eng_name/) 	    
		&& do {
			$temp=$self->unpack_engine_tree(\$val);
			last;
			}
	}
	close FH;
	return $temp;
	}
return {};
}

sub pack_engine_tree(){
my $self=shift;
my $eng_ref=$self->Engine();
#Fetch object's state tree
my $tree=$eng_ref->_get_vars();
  sub test{
  my (@pars,$res);
  my $par=$_[0];
  foreach my $key (keys(%{$par})){
  if (ref($par->{$key}) eq "HASH"){
  $res.=$key."{".&test($par->{$key})."}";
  } else{
  my $tr=encode_base64($par->{$key});
  $tr=~tr/\=/\!/;
  chomp($tr);
  $res.="$key=".$tr.";";
  }}
  return $res;
  }
#return string eq to 
#Text3{_info=T2Zm;Val=LQ!!;Par=MA!!;}Panel1{Test=VEVTVElORw!!;Test2=MQ!!;_info=T2Zm;}Par=aGk!;Text1{_info=T2Zm;Val=Kw!!;Par=MA!!;}
return &test($tree)
}

sub store{
my $self=shift;
my $ref_par=shift;
my ($id,$tree,$eng_name)=@$ref_par{"id","tree","eng_name"};
my %reestr;
my ($rec,$key,$eng,$val);
if (open FH,"<".$self->Db_file){
	while ($rec=<FH>){
	($key,$eng,$val)= $rec=~/^(.*)\.\|\.(.*)\.\|\.(.*)$/;
	$reestr{$key}{$eng}=$val;
	}
	close FH;
}
$reestr{$id}{$eng_name}=$self->pack_engine_tree();
if (open FH,">".$self->Db_file) { 
	foreach my $key (keys %reestr){
		foreach my $name (keys %{$reestr{$key}}){
		print FH "$key\.\|\.$name\.\|\.",$reestr{$key}{$name},"\n";
		}
	}
	close FH;
}
return $id;
}

1;
