#!/usr/bin/perl

use strict;               # to catch stupid errors

#
# BFilter directives for blocking and exempting Adblock Plus URL patterns
# (Strong and weak versions required, see comments below)
#
my $BLOCK_PREFIX_STRONG = "++++++";
my $BLOCK_PREFIX_WEAK = "+++";
my $EXEMPT_PREFIX_STRONG = "ALLOW";
my $EXEMPT_PREFIX_WEAK = "---";

#
# The main loop
#
while (defined(my $thisLine = <STDIN>))
{
    print processLine(trim($thisLine));
}
exit;


####################################
# Subroutines
####################################

#
# Process a single line from STDIN
#
sub processLine()
{
    # The incoming line has been stripped of leading and trailing
    # white space and the terminating newline.
    my ($line) = @_;

    # Copy blank lines
    if ($line =~ m/^$/)
    {
        return "\n";
    }

    # Handle comment and Adblock Plus header lines
    if ($line =~ m/^[\[!]/)
    {
        return "# $line\n";;
    }

    # Handle unimplemented lines
    # (These are Adblock Plus element-hiding patterns)
    if ($line =~ m/#/)
    {
        return "# <Element> $line\n";
    }

    # See if this is an Exception pattern
    # If so, strip "@@" from the front of the line.
    my $isException = ($line =~ m/^@@/);
    if ($isException)
    {
        $line =~ s/^@@//;
    }

    # Is the pattern already in regex form?
    my $isRegEx = ($line =~ m/^\/.*\/$/);

    # Used to construct the output line.
    my $prefix;
    my $pattern;

    # We process regex patterns differently from others.
    if ($isRegEx)
    {
        # Use the existing regex with an appropriate BFilter prefix.
        $prefix = $isException ? $EXEMPT_PREFIX_STRONG : $BLOCK_PREFIX_STRONG;
	$pattern = $line;
    }
    else
    {
        # If the pattern includes "filter options", which BFilter cannot support,
	# strip them from the line and use a weak BFilter prefix.
        my $isWeak = ($line =~ m/\$/);
        if ($isWeak)
        {
            $line =~ s/\$.*//;
        }

        # Check to see whether the pattern is anchored at one or both ends
	# if so, strip the anchor characters from the line.
        my $anchoredStart = ($line =~ m/^\|/);
        my $anchoredEnd = ($line =~ m/\|$/);
	if ($anchoredStart || $anchoredEnd)
	{
	    $line =~ s/\|//g;
	}

	# Remove redundant strings of wildcards
	$line =~ s/\*+/\*/g;

	# If the pattern contains a literal '?', we need to convert it 
	# to a regex because '?' is used as a wild card in BFilter.
        my $convertToRegEx = ($line =~ m/\?/);
        if ($convertToRegEx)
        {
	    # We replace ? with \? in the output regex.
	    # We also need to escape certain other characters that
	    # have special meaning in a regex: . + \
            $line =~ s/([\?\/\.\+])/\\\1/g;

	    # Are there wildcards at the unanchored beginning and/or end 
	    # of a pattern? If so, remove them now.
	    if (!$anchoredStart)
	    {
	        $line =~ s/^\*//;
	    }
	    if (!$anchoredEnd)
	    {
	        $line =~ s/\*$//;
	    }

	    # Translate * to .* in the regex.
            $line =~ s/[\*]/\.\*/g;

            # Build the regex version of the pattern.
	    $pattern = "/";
	    if ($anchoredStart)
	    {
	        $pattern = $pattern . '^';
	    }
	    $pattern = $pattern . $line;
	    if ($anchoredEnd)
	    {
	        $pattern = $pattern . '$';
	    }
	    $pattern = $pattern . "/";
        }
        else
        {
	    # regex not required. Construct an output pattern with
	    # appropriate anchoring.
	    $pattern = "";
	    if (!$anchoredStart)
	    {
	        # Add a wildcard if there is not already one at the start.
		if (!($line =~ m/^\*/))
		{
		    $pattern = $pattern . "*";
		}
	    }
	    $pattern = $pattern . $line;
	    if (!$anchoredEnd)
	    {
	        # Add a wildcard if there is not already one at the end.
		if (!($line =~ m/\*$/))
		{
		    $pattern = $pattern . "*";
		}
	    }
        }

        # Use the approprite prefix - weak or strong.
        if ($isException)
        {
            $prefix = $isWeak ? $EXEMPT_PREFIX_WEAK : $EXEMPT_PREFIX_STRONG;
        }
        else
        {
            $prefix = $isWeak ? $BLOCK_PREFIX_WEAK : $BLOCK_PREFIX_STRONG;
        }
    }

    return "$prefix $pattern\n";
}

#
# Remove the newine from the string then
# strip leading and trailing white space.
#
sub trim()
{
    my ($string) = @_;

    chomp $string;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;

    return $string;
}