# Perl script to match case law references

I am very new to Perl and decided to work on a simple script that could solve a problem I encounter in my day to day work. The purpose of the code that follows is to search over a body of text and extract English case law publication references. There are quite a few flavours of reference style, so I have several expressions looking for different reference structures.

I'm very much at the "hooray, I've managed to make it work"-stage on the Perl learning curve, but know enough to recognise that this code is pretty hideous.

There are two main areas I'm aiming to improve:

1. Getting the source text from a file, rather than plonking it directly into the code.
2. Getting the output to write to a output.txt file.

An examples of obvious poor practice is that I have used strict or warnings. The interpreter didn't like various aspects of the code.

I'd be really grateful for some feedback on this very modest first attempt to use Perl in an applied way. It is pretty hideous and I'm sure there are endless ways in which this could be achieved more elegantly.

The Code

#!/usr/bin/perl

# Paste text to review below

$search_text = <<EOD; In Salomon v A Salomon and Co Ltd [1897] AC 22, the House of Lords held that these principles applied as much to a company that was wholly owned and controlled by one man as to any other company. In Macaura v Northern Assurance Co Ltd [1925] AC 619, the House of Lords held that the sole owner and controller of a company did not even have an insurable interest in property of the company, although economically he was liable to suffer by its destruction. Lord Buckmaster, at pp 626-627 said: EOD print "\n-----------------------------\n"; print "Case References Found in Text"; print "\n-----------------------------\n"; # Find NCits print "\n***** NCits...\n\n"; while ($search_text =~ m/(($$|$)\d{4}($$|$))(\s+((EWHC)|(EWHC\s+Admin)|(CAT)|(EWCA)|(EWCA\s+Civ)|(EWCA\s+Crim)|(EWCOP)|(EWFC)|(EWFC\s+B)|(EWPCC)|(UKHL)|(UKIAT)|(UKPC)|(UKSC)|(CSOH)|(CSIH)|(NICA)|(IESC)|(IECCA)|(IECA)|(IEHC)|(UKUT))\s+\d+)/ig) {

print "$1$4\n";
}

# Find WLR

print "\n***** WLR references...\n\n";

while ($search_text =~ m/((|$)\d{4}(\)|$))(\s+\d+\s+((WLR))\s+\d+)/ig) { print "$1$4\n"; } # Find AC with vol number print "\n***** Appeal Cases references...\n\n"; while ($search_text =~ m/((|$)\d{4}(\)|$))(\s+\d+\s+((AC))\s+\d+)/ig) {

print "$1$4\n";

}

# Find AC with no vol number

while ($search_text =~ m/((|$)\d{4}(\)|$))(\s+((AC))\s+\d+)/ig) { print "$1$4\n"; } # Find QB with vol number print "\n***** Queen's Bench Cases cases...\n\n"; while ($search_text =~ m/((|$)\d{4}(\)|$))(\s+\d+\s+((QB))\s+\d+)/ig) {

print "$1$4\n";
}

# Find QB with no vol number

while ($search_text =~ m/((|$)\d{4}(\)|$))(\s+((QB))\s+\d+)/ig) { print "$1$4\n"; } print "\n***** External references...\n\n"; while ($search_text =~ m/(($$|$)\d{4}($$|$)){0,1}(\s*\d+\s+((TLR)|(TLR\s+$$Pt\s+1$$)|(TLR\s+$$Pt\s+2$$)|(LGR)|(Cr\s*App\s*R)|(Cr\s*App\s*R\s*$$S$$)|(Ll\s*L\s*Rep)|(LlLR)|(TC)|(FLR)|(BCLC))\s+\d+)/ig) {

print "$1$4\n";
}

# Find NIQB

print "\n***** NI Queen's Bench Cases cases...\n\n";

while ($search_text =~ m/((|$)\d{4}(\)|$))(\s+((NIQB))\s+\d+)/ig) { print "$1$4\n"; } # Find NZLR print "\n***** NZLR references...\n\n"; while ($search_text =~ m/((|$)\d{4}(\)|$))(\s+\d+\s+((NZLR))\s+\d+)/ig) {

print "$1$4\n";

}

# Find All ER

while ($search_text =~ m/((|$)\d{4}(\)|$))(\s+\d+\s+((All ER))\s+\d+)/ig) { print "$1$4\n"; } # Find ECR print "\n***** ECR references...\n\n"; while ($search_text =~ m/((|$)\d{4}(\)|$))(\s+((ECR))\s+\d+)/ig) {

print "$1$4\n";
}

# Old Style ICLR Refs

print "\n***** Older volume references...\n\n";

while ($search_text =~ m/(\d+\s+((App\s*Cas)|(Ch\s*D)|(CPD)|(Ex\s*D)|(P.D.)|(Q.B.D.))\s+\d+)/ig) { print "$1$4\n"; }  • You have a lot of capturing parentheses in your regexes, yet in all cases you just end up printing the entire match. Is your intention just to print the entire match, or do you actually need to analyze the subparts further? – 200_success Nov 13 '16 at 7:32 • @200_success: that's a fair point. The first objective is just to print the entire match. The second objective, further down the line (if I get that far), is to construct a URL from each match, which is going to involve reordering some of the elements in the matched string, e.g. cases.iclr.co.uk/sub/gateway.dll/WlRO/wlr2016/… – DanielH Nov 13 '16 at 7:41 ## 1 Answer Adding use warnings; at the top of the script doesn't emit any warnings. Adding use strict; makes the variable $search_text undeclared, but it's easy to fix it by adding my before its first use.

The easiest way to read the input from a file is to specify the filename as a parameter to the script, and read from the file with the diamond operator <> looping over the input lines:

while (my $search_text = <>) {  Also, there's a lot of repetition in your code. To deduplicate it, you can store the regular expressions in a hash keyed by the type of the reference. It shortens your script to #!/usr/bin/perl use warnings; use strict; my %reference = ( NCits => [ qr/(($$|$)\d{4}($$|$))(\s+((EWHC)|(EWHC\s+Admin)|(CAT)|(EWCA)|(EWCA\s+Civ)|(EWCA\s+Crim)|(EWCOP)|(EWFC)|(EWFC\s+B)|(EWPCC)|(UKHL)|(UKIAT)|(UKPC)|(UKSC)|(CSOH)|(CSIH)|(NICA)|(IESC)|(IECCA)|(IECA)|(IEHC)|(UKUT))\s+\d+)/ ], WLR => [ qr/((|$)\d{4}(\)|$))(\s+\d+\s+((WLR))\s+\d+)/ ], 'Appeal Cases' => [ qr/((|$)\d{4}(\)|$))(\s+\d+\s+((AC))\s+\d+)/, qr/((|$)\d{4}(\)|$))(\s+((AC))\s+\d+)/ ], "Queen's Bench Cases" => [ qr/((|$)\d{4}(\)|$))(\s+\d+\s+((QB))\s+\d+)/, qr/((|$)\d{4}(\)|$))(\s+((QB))\s+\d+)/ ], 'External references' => [ qr/(($$|$)\d{4}($$|$)){0,1}(\s*\d+\s+((TLR)|(TLR\s+$$Pt\s+1$$)|(TLR\s+$$Pt\s+2$$)|(LGR)|(Cr\s*App\s*R)|(Cr\s*App\s*R\s*$$S$$)|(Ll\s*L\s*Rep)|(LlLR)|(TC)|(FLR)|(BCLC))\s+\d+)/ ], "NI Queen's Bench Cases" => [ qr/((|$)\d{4}(\)|$))(\s+((NIQB))\s+\d+)/ ], NZLR => [ qr/((|$)\d{4}(\)|$))(\s+\d+\s+((NZLR))\s+\d+)/, qr/((|$)\d{4}(\)|$))(\s+\d+\s+((All ER))\s+\d+)/ ], ECR => [ qr/((|$)\d{4}(\)|$))(\s+((ECR))\s+\d+)/ ], 'Older volume' => [ qr/(\d+\s+((App\s*Cas)|(Ch\s*D)|(CPD)|(Ex\s*D)|(P.D.)|(Q.B.D.))\s+\d+)/ ], ); print "\n-----------------------------\n"; print "Case References Found in Text"; print "\n-----------------------------\n"; while (my$search_text = <>) {
for my $type (keys %reference) { print "\n*****$type *****\n";
for my $regex ( @{$reference{$type} } ) { while ($search_text =~ /$regex/ig) { print "$1$4\n"; } } } }  In a regex, (\(|\[) can be more readably written as ([[(]). For grouping without capturing, you can use (?: instead of (. For example, the NCits regex can be written as /((?:[[(])\d{4}(?:[])]))(\s+(?:EWHC(?:\s+Admin)?|CAT|EWCA(?:\s+(?:Civ|Crim))?|EW(?:COP|PCC)|EWFC(?:\s+B)?|UK(?:HL|IAT|[PS]C|UT)|CS(?:[OI]H)|NICA|IE(?:SC|CCA|CA|HC))\s+\d+)/  which changes the variables to output to $1$2. To output to a file, just redirect the output: script.perl input-file > output-file  • Gosh! Thank you for such a helpful response! This is the second time you've helped me on here, I believe! – DanielH Nov 12 '16 at 21:10 • Do I pass the input file name as an argument when running the script at the command line, e.g. perl script.pl input.txtor between <>. e.g. while (my$search_text = <input.txt>) {? I've tried both methods. The script runs, it just doesn't return any matches when it ought to. – DanielH Nov 12 '16 at 22:21
• On *nix, try perl script.pl < input.txt. The first option you posted needs additional work in the script to process. The second option is just wrong. You'd put a file object in the <>, e.g. <STDIN> -- which is the explicit way to write the default. – mdfst13 Nov 12 '16 at 22:28
• @DanielH: Giving the filename as an argument works for me. – choroba Nov 12 '16 at 23:36
• @choroba: I've worked out what's happening. I've passed it a text file with 267 lines, so it's iterating over the while loop for every line and printing a full set of \$type for each line! I need to crunch the text file down to one line. I basically dumped (bailii.org/uk/cases/UKSC/2016/3.html) into a text file and hoped for the best! – DanielH Nov 13 '16 at 0:06