view release on metacpan or  search on metacpan

lib/Apache/ASP/State.pm  view on Meta::CPAN

		    $internal->{$id} = $idata;
		}
	    }
	} else {
	    # this state has already been created
	    $state_db = $idata->{state_db};
	    $state_serializer = $idata->{state_serializer};
	}
    } else {
	# cache layer doesn't need internal
	($state_db, $state_serializer) = ($asp->{state_db}, $asp->{state_serializer});
    }

    my $self = 
      bless {
	     asp=>$asp,
	     dbm => undef, 
	     'dir' => $group_dir,
	     id => $id, 
	     file => $file,
	     group => $group, 
	     group_dir => $group_dir,
	     reads => 0,
	     state_dir => $state_dir,
	     writes => 0,
	    };

    # short circuit before expensive directory tests for group stub
    if ($group eq $id) {
	return $self;
    }

    if($asp->config('StateAllWrite')) {
	$asp->{dbg} and $asp->{state_all_write} = 1;
	$self->{dir_perms} = 0777;
	$self->{file_perms} = 0666;
    } elsif($asp->config('StateGroupWrite')) {
	$asp->{dbg} and $asp->{state_group_write} = 1;
	$self->{dir_perms} = 0770;
	$self->{file_perms} = 0660;
    } else {
	$self->{dir_perms} = 0750;
	$self->{file_perms} = 0640;
    }

#    push(@{$self->{'ext'}}, @{$DB{$self->{state_db}}});    
#    $self->{asp}->Debug("db ext: ".join(",", @{$self->{'ext'}}));

    # create state directories
    my @create_dirs;
    unless(-d $state_dir) {
	push(@create_dirs, $state_dir);
    }
    # create group directory
    unless(-d $group_dir) {
	push(@create_dirs, $group_dir);
    }
    if(@create_dirs) {
	$self->UmaskClear;
	for my $create_dir (@create_dirs) {
#	    $create_dir =~ tr///; # this doesn't work to untaint with perl 5.6.1, use old method
	    $create_dir =~ /^(.*)$/s;
	    $create_dir = $1;
	    if(mkdir($create_dir, $self->{dir_perms})) {
		$asp->{dbg} && $asp->Debug("creating state dir $create_dir");
	    } else {
		my $error = $!;
		-d $create_dir || $self->{asp}->Error("can't create group dir $create_dir: $error");
	    }
	}
	$self->UmaskRestore;
    }

    # INIT MLDBM::Sync DBM
    { 
	local $MLDBM::UseDB = $state_db || 'SDBM_File';
	local $MLDBM::Serializer = $state_serializer || 'Data::Dumper';
	# clear current tied relationship first, if any
	$self->{dbm} = undef; 
	local $SIG{__WARN__} = sub {};
	
	my $error;
	$self->{file} =~ /^(.*)$/; # untaint
	$self->{file} = $1;
	local $MLDBM::RemoveTaint = 1;
	$self->{dbm} = &MLDBM::Sync::TIEHASH('MLDBM', $self->{file}, O_RDWR|O_CREAT, $self->{file_perms});
	$asp->{dbg} && $asp->Debug("creating dbm for file $self->{file}, db $MLDBM::UseDB, serializer: $MLDBM::Serializer");
	$error = $! || 'Undefined Error';


	if(! $self->{dbm}) {
	    $self->{asp}->Error(qq{
Cannot tie to file $self->{file}, $error !!
Make sure you have the permissions on the directory set correctly, and that your
version of Data::Dumper is up to date. Also, make sure you have set StateDir to 
to a good directory in the config file.  StateDir defaults to Global/.state
});
	}
    }

    $self;
}

sub Init   { shift->{dbm}->CLEAR(); }
sub Size   { shift->{dbm}->SyncSize; }
sub Delete { shift->{dbm}->CLEAR(); }
sub WriteLock { shift->{dbm}->Lock; }
sub ReadLock { shift->{dbm}->ReadLock; }
sub UnLock { shift->{dbm}->UnLock; }

sub DeleteGroupId {
    my $self = shift;

    my $group_dir = $self->{group_dir};
    if(-d $group_dir) {
	$self->{asp}{Internal}->LOCK;
	if(rmdir($group_dir)) {
	    $self->{asp}->Debug("deleting group dir $group_dir");
	} else {
	    $self->{asp}->Log("cannot delete group dir $group_dir: $!");
	}
	$self->{asp}{Internal}->UNLOCK;
    }
}

sub GroupId { shift->{group}; }

sub GroupMembers {
    my $self = shift;
    local(*DIR);
    my(%ids, @ids);

    unless(opendir(DIR, $self->{group_dir})) {
	$self->{asp}->Log("opening group $self->{group_dir} failed: $!");
	return [];
    }

    for(readdir(DIR)) {
	next if /^\.\.?$/;
	$_ =~ /^(.*?)(\.[^\.]+)?$/;
	next unless $1;
	$ids{$1}++;
    }