view release on metacpan or  search on metacpan

lib/Acme/Comment.pm  view on Meta::CPAN

}

sub import {
    my $package = shift;
    my %args    = @_;

    if(@_%2){
        die "Incomplete set of arguments to $package\n"
    }

    ### see if there are any arguments, if not, we default to the C comment style ###
    if( keys %args ) {

        ### check if the user requested a certain type of comments ###
        if( $args{type} ) {

            ### and check if it even exists ###
            if( $Conf->{ uc $args{type} } ) {
                $Type = uc $args{type};

                $Conf->{$Type}->{own_line} = $args{own_line} if defined $args{own_line};
                $Conf->{$Type}->{one_line} = $args{one_line} if defined $args{one_line};

            ### otherwise die with an error ###
            } else {
                die "Requested an unsupported type $args{type} for Acme::Comment\n";
            }

        ### otherwise, define a new type for the user ###
        } else {
            $Type = ++$TypeCount;

            unless( (defined $args{start} and defined $args{end}) or defined $args{single} ) {
                die "You need to specify both start and end tags OR a single line comment!\n";
            } else {
                if( defined $args{start} and defined $args{end} and $args{start} eq $args{end} ) {
                    die "Start and end tags must be different!\n";
                }

                $Conf->{$TypeCount}->{start}    = quotemeta($args{start})  if defined $args{start};
                $Conf->{$TypeCount}->{end}      = quotemeta($args{end})    if defined $args{end};
                $Conf->{$TypeCount}->{single}   = quotemeta($args{single}) if defined $args{single}
            }

            $Conf->{$TypeCount}->{own_line} = defined $args{own_line}
                                                ? $args{own_line}
                                                : 1;

            $Conf->{$TypeCount}->{one_line} = defined $args{one_line}
                                                ? $args{one_line}
                                                : 0;

        }

    ### no arguments, Let's take the default C comment style ###
    }
}

sub parse {

    #use Data::Dumper;
    #print scalar @_;
    #die Dumper \@_;

    my $str = shift;

    my $start   = $Conf->{$Type}->{start}     if $Conf->{$Type}->{start};
    my $end     = $Conf->{$Type}->{end}       if $Conf->{$Type}->{end};
    my $single  = $Conf->{$Type}->{single}    if $Conf->{$Type}->{single};

    my ($rdel,$ldel);
    my ($roneline, $loneline);

    if( $start && $end ) {
        ### having the comments on their own line is recommended
        ### to avoid ambiguity -kane
        $roneline = '\s*' . $end . '\s*$';
        $loneline = '^\s*' . $start . '\s*';

        if( $Conf->{$Type}->{own_line} ){
            $rdel = '^' . $roneline;
            $ldel = $loneline . '$';
        } else {
            $rdel = $roneline;
            $ldel = $loneline;
        }
    }

    ### loop counter ###
    my $i;

    ### tag counter ###
    my $counter;

    ### line number of the last found comment open ###
    my $lastopen;

    ### return value container ###
    my @return;

    for my $line (split/\n/, $str) {
        ### increase line counter ###
        $i++;

        ### if there is a single line comment available ##
        if($single) {
            if( $line =~ m|^\s*$single| ) {
    	        push @return, "";
    	    	next;
	        }
        }

        ### check if we have multiline comment options ###
        if($roneline && $loneline) {
            ### check if we are allowed to have comments on one line
            ### and if so, see if they match
            if( $Conf->{$Type}->{one_line} ) {
                if( $line =~ /$loneline.*?$roneline/) {
		            push @return, "";
                    next;
                }