view release on metacpan or  search on metacpan

lib/Apache/Admin/Config.pm  view on Meta::CPAN

    my($line, $raw_line);
    my $n = 0;
    while((defined $fh) && ($line = scalar <$fh>) && (defined $line))
    {
        $n++;
        my $length = 1;
        $raw_line = $line;

        while($line !~ /^\s*#/ && $line =~ s/\\$//)
        {
            # line is truncated, we want the entire line
            $n++;
            $length++;
            chomp($line);
            my $next .= <$fh> 
                or return $self->_set_error(sprintf('%s: syntax error at line %d', $file, $n));
            $raw_line .= $next;
            $next =~ s/^\s*|\s*$//g;
            $line .= $next;
        }

        $line =~ s/^\s*|\s*$//g;

        if($line =~ /^\s*#\s?(.*?)\s*$/)
        {
            # it's a comment
            _insert_comment($level[-1], $1, $raw_line, undef, $cgroup);
        }
        elsif($line eq '')
        {
            # it's a blank line
            _insert_blank($level[-1], $raw_line, undef, $bgroup);
        }
        elsif($line =~ /^(\w+)(?:\s+(.*?)|)$/)
        {
            # it's a directive
            _insert_directive($level[-1], $1, $2, $raw_line, $length);
        }
        elsif($line =~ /^<\s*(\w+)(?:\s+([^>]+)|\s*)>$/)
        {
            # it's a section opening
            my $section = _insert_section($level[-1], $1, $2, $raw_line, $length);
            push(@level, $section);
        }
        elsif($line =~ /^<\/\s*(\w+)\s*>$/)
        {
            # it's a section closing
            my $section_name = lc $1;
            return $self->_set_error(sprintf('%s: syntax error at line %d', $file, $n)) 
              if(!@level || $section_name ne lc($level[-1]->{name}));
            $level[-1]->{raw2} = $raw_line;
            $level[-1]->{length2} = $length;
            pop(@level);
        }
        else
        {
            return $self->_set_error(sprintf('%s: syntax error at line %d', $file, $n));
        }
    }

    eval('use Data::Dumper; print Data::Dumper::Dumper($self), "\n";') if($Apache::Admin::Config::DEBUG);

    return 1;
}

sub _get_arg
{
    my($args, $motif) = @_;
    # motif is a list of searched argument separated by a pipe
    # each arguments can be ended by a ! for specifing that it don't wait for a value
    # (ex: "-arg1|-arg2!" here -arg2 is boolean)
    # return (value, argname)

    return '' unless(@$args);
    for(my $n = 0; $n < @$args; $n++)
    {
        foreach my $name (split(/\|/, $motif))
        {
            my $boolean = ($name =~ s/\!$//);
            if(defined $args->[$n] && !ref($args->[$n]) && $args->[$n] eq $name)
            {
                return(undef) if(!$boolean && $n+1 >= @$args); # malformed argument
                my $value = splice(@$args, $n, ($boolean?1:2));
                $value = '' unless defined $value;
                return(wantarray ? ($value, $name) : $value); # suppres argument name and its value from the arglist and return the value
            }
        }
    }
    return '';
}

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

sub _load
{
    my($self, $htaccess) = @_;
    my @htaccess;
    my $fh;

    $self->{htaccess} = $htaccess;

    if(ref $htaccess eq 'GLOB')
    {
        $fh = $htaccess;
    }
    else
    {
        # just return true if file doesn't exist and -create was enabled
        return 1 if(not -f $htaccess and $self->{create});
        
        return $self->_set_error("`$htaccess' not readable") unless(-r $htaccess);
        $fh = new FileHandle($htaccess) or return $self->_set_error("can't open `$htaccess' file for reading");
    }
    
    return $self->_parse($fh);
}