File Coverage

blib/lib/File/Comments/Plugin/C.pm

Criterion	Covered	Total	%
statement	34	36	94.4
branch	2	2	100.0
condition			n/a
subroutine	9	10	90.0
pod	0	6	0.0
total	45	54	83.3

###########################################
# File::Comments::Plugin::C
# 2005, Mike Schilli
###########################################

###########################################
package File::Comments::Plugin::C;
###########################################

use strict;
use warnings;
use File::Comments::Plugin;
use Log::Log4perl qw(:easy);

our $VERSION = "0.01";
our @ISA     = qw(File::Comments::Plugin);

###########################################
sub init {
###########################################
    my($self) = @_;

    $self->register_suffix(".c");
    $self->register_suffix(".cpp");
    $self->register_suffix(".cc");
    $self->register_suffix(".CC");
    $self->register_suffix(".C");
    $self->register_suffix(".h");
    $self->register_suffix(".H");
}

###########################################
sub type {
###########################################
    my($self, $target) = @_;

    return "c";
}

###########################################
sub comments {
###########################################
    my($self, $target) = @_;

    return $self->extract_c_comments($target);
}

###########################################
sub stripped {
###########################################
    my($self, $target) = @_;

    return $self->strip_c_comments($target);
}

###########################################
sub extract_c_comments {
###########################################
    my($self, $target) = @_;

    my @comments = ();

        # This will get confused with c strings containing things
        # like "/*", but good enough for now until we can hook in a full
        # C parser/preprocessor.
    while($target->{content} =~
            m#/\*(.*?)\*/|
              //(.*?)$
             #mxsg) {
        push @comments, defined $1 ? $1 : $2;
    }

    return \@comments;
}

###########################################
sub strip_c_comments {
###########################################
    my($self, $target) = @_;

    my @comments = ();

        # This will get confused with c strings containing things
        # like "/*", but good enough for now until we can hook in a full
        # C parser/preprocessor.
    my $stripped = $target->{content};

    $stripped =~
            s#^\s*/\*.*?\*/(\s*\n)?|
              /\*.*?\*/|
              ^\s*//.*?\n|
              \s*//.*?$
             ##mxsg;

    return $stripped;
}

1;

__END__