view release on metacpan or  search on metacpan

lib/Hardware/Vhdl/Automake/PreProcessor/Cish.pm  view on Meta::CPAN

        $state->{incsection_found} = 0;
        $state->{copyon} = 0;
    }
    #print "## new PreProcessor::Cish is reading $state->{source}\n";
    bless $self, $class;
    $self->update_macro_re;
    $self;
}

sub files_used {
    keys %{ $_[0]->[0]{files_used} };
}

sub linenum {
    # returns the line number of the last line fetched
    $_[0]->[-1]{linenum};
}

sub sourcefile {
    # returns the source file of the last line fetched
    $_[0]->[-1]{source};
}

sub unget {
    my $perm  = shift->[0];
    $perm->{ungot} = $_[0] . $perm->{ungot};
}

sub _just_get_a_line {
    my $self  = shift;
    my $state = $self->[-1];
    $state->{line} = undef;    # default return value
    my $bufname = exists $state->{sourcestring} ? 'sourcestring' : 'filebuf';

# Just what is used as a newline may vary from OS to OS. Unix traditionally uses \012, one type of DOSish I/O uses \015\012, and Mac OS uses \015.

    GET_LINE: {
        my $rem;
        if (defined $state->{endat}) { $rem = $state->{endat} - tell($state->{fhi}) } # REMainding bytes we are allowed to read from the file
        if ( $state->{$bufname} =~ m/^(.*?(\015\012?|\012\015?))(.*)$/s ) {
            $state->{line}     = $1;
            $state->{$bufname} = $3;
        } elsif ( exists $state->{fhi} && !eof $state->{fhi} && (!defined $rem || ($rem > 0))) {
            local $/ = \$file_slurp_limit;
            if (defined $rem && $file_slurp_limit > $rem) { $/ = \$rem }
            $state->{$bufname} .= readline $state->{fhi};
            redo GET_LINE;
        } else {
            $state->{line}     = $state->{$bufname};
            $state->{$bufname} = '';
        }
    }
    $state->{line} = undef if $state->{line} eq '';
}

sub macro_define {
    my ($self, $macname, $macdef) = @_;
    my $perm  = $self->[0];
    $macdef = '' if !defined $macdef;
    if (exists $perm->{macros}{$macname}) {
        carp "Macro '$macname', defined at $perm->{macros}{$macname}{defined_in} line $perm->{macros}{$macname}{linenum}, was redefined";
    }
    $perm->{macros}{$macname} = { search => $macname, replace => $macdef, defined_in => $self->[-1]{source}, defined_line => $self->[-1]{linenum} };
    $self->update_macro_re;
}

sub macro_define_func {
    my ($self, $macname, $fargs, $macdef) = @_;
    $fargs =~ s/\s+//g;
    my @args = split(',', $fargs);
    my $arg_re = join '|', @args;
    #print "# macro function define: name='$macname', arg re='$arg_re', definition='$macdef'\n";
    $self->[0]{macros}{$macname.'('.scalar(@args)} = {
        search => $macname.'(',
        arg_re => qr/^(.*?)\b($arg_re)\b(.*)$/s,
        arg_index => { map { $args[$_] => $_ } 0..$#args },
        replace => $macdef,
        defined_in => $self->[-1]{source},
        defined_line => $self->[-1]{linenum}
      };
    $self->update_macro_re;
}

sub macro_undefine {
    my ($self, $macname) = @_;
    my $perm  = $self->[0];
    delete $perm->{macros}{$macname};
    $self->update_macro_re;
}

sub macro_undefine_func {
    my ($self, $macname, $args) = @_;
    print "# macro function undef: name='$macname', args='$args'\n";
    my @args = split(',', $args);
    delete $self->[0]{macros}{$macname.'('.scalar(@args)};
    $self->update_macro_re;
}

sub update_macro_re {
    my $perm  = shift->[0];
    my @macnames;
    my %macfuncnames;
    for my $search (map { $perm->{macros}{$_}{search} } keys %{$perm->{macros}}) {
        if (substr($search, -1) eq '(') {
            $macfuncnames{quotemeta($search)} = undef;
        } else {
            push @macnames, $search."\\b";
        }
    }
    my $macro_re = join '|', @macnames, keys %macfuncnames;
    #print "# macro regexp = /^(.*?)\\b($macro_re)(.*)\$/s\n";
    $perm->{macro_re} = qr/^ (.*?) ( " | \b(?:$macro_re) ) (.*) $/xs;
}

sub macro_replace {
    # do macro expansion on the non-quoted parts of $state->{line}
    my $self  = shift;
    my $perm  = $self->[0];
    my $state = $self->[-1];
    my $out = $self->_macro_replace_string($state->{line}, []);
    #~ if ( $out =~ m/^(.*?(\015\012?|\012\015?))(.*)$/s ) {