view release on metacpan or  search on metacpan

Debug.pm  view on Meta::CPAN

	    {
		next unless defined $val;
		if( ref $val )
		{
		    die "'$name' must be scalar...\n";
		}
		push @$newref, $val;
	    }
	    return $newref;
	}
    }
    elsif( $struct_ref eq 'HASH' )
    {
	if( not $params_ref )
	{
	    $result = { $params => undef }; # The "undef" will later be defined
	}
	elsif( $params_ref eq 'HASH' )
	{
	    $result = $params;
	}
	elsif( $params_ref eq 'ARRAY' )
	{
	    $result = {};
	    foreach my $key ( @$params )
	    {
		$result->{$key} = undef;
	    }
	}
	else
	{
	    die "'$name' must be scalar or hash ref...\n";
	}

	my $newref = {};
	foreach my $key ( keys %$result )
	{
	    next unless defined $key;
	    my @struct_keys = keys %$struct;
	    if( @struct_keys and not grep { $key eq $_ } @struct_keys )
	    {
		my @sorted = sort @struct_keys;
		die "'$key' in '$name' not one of qw(@sorted)\n";
	    }

	    $newref->{$key} = &unravel( $result->{$key}, $struct->{$key}, $key );
	}

	return $newref;
    }

    die "Internal error: ${Module}::unravel only supports scalars, hashes and arrays";
}

sub set_defaults
{
    my $module_name = $Module;
    $module_name =~ s/::/-/g;

    my $uid = (stat( $0 ))[4];
    my $user = getpwuid($uid);

    ### Control to
    #
    my %default_to = (
		      browser => 1,
		      log     => 1,
		      file    => ["${File_base}-error.txt"],
		      mail    => [$user],
		      );
    foreach my $pref (keys %default_to)
    {
	foreach( CGI::cookie("${module_name}-to-$pref"),
		 (exists $ENV{"${module_name}-to-$pref"}
		  and $ENV{"${module_name}-to-$pref"} ),
		 )
	{
	    $_ and $Control->{'to'}{$pref}=$_ and last;
	}
	if( exists $Control->{'to'} and
	    exists $Control->{'to'}{$pref} and
	    not defined $Control->{'to'}{$pref})
	{
	    $Control->{'to'}{$pref} = $default_to{$pref};
	}
    }


    ### Control
    #
    my %default = (
		   report => 'environment',
		   on     => 'warnings',
		   to     => 'browser',
		   );
    foreach my $pref ('report','on')
    {
	foreach( CGI::cookie("${module_name}-$pref"),
		 (exists $ENV{"${module_name}-$pref"}
		  and $ENV{"${module_name}-$pref"} ),
		 )
	{
	    $_ and $Control->{$pref}{$_}= 1 and last;
	}
	$Control->{$pref}
	or $Control->{$pref}{$default{$pref}} = 1;
    }

    ### Default for  Control to
    #
    foreach( CGI::cookie("${module_name}-to"),
	     (exists $ENV{"${module_name}-to"}
	      and $ENV{"${module_name}-to"} ),
	     )
    {
	$_ and $Control->{'to'}{$_}= $default_to{$_} and last;
    }
    $Control->{'to'} or $Control->{'to'}{$default{'to'}} =
	$default_to{$default{'to'}};