Is it possible to parse this nightmare using Perl?

Question

I'm working on some doc file, that when copied and pasted into a text file, gives me the following sample 'output':

ARTA215   ADVANCED LIFE DRAWING (3 Cr) (2:2)  + Studio 1 hr.
This advanced study in drawing with the life ....
Prerequisite: ARTA150
Lab Fee Required

ARTA220   CERAMICS II  (3 Cr) (2:2)  + Studio 1 hr.
This course affords the student the opportunity to ex...
Lab Fee Required

ARTA250   SPECIAL TOPICS IN ART 
  This course focuses on selected topic....

ARTA260   PORTFOLIO DEVELOPMENT   (3 Cr) (3:0)
The purpose of this course is to pre....
BIOS010   INTRODUCTION TO BIOLOGICAL CONCEPTS (3IC) (2:2) 
This course is a preparatory course designed to familiarize the begi....

BIOS101   GENERAL BIOLOGY (4 Cr) (3:3)
This course introduces the student to the principles of mo...
Lab Fee Required

BIOS102   INTRODUCTION TO HUMAN BIOLOGY  (4 Cr)  (3:3)
This course is an introd....
Lab Fee Required

I want to be able to parse it so that 3 fields are generated and I could output the values into a .csv file.

The line breaks, spacing, etc... is how it could be at any point during this file.

My best guess is for a regex to find 4 capitalized alpha chars followed by 3 num chars, then find out if the next 2 chars are capitalized. (this accounts for the course #, but also excludes the possibility of tripping up during where it might say "prerequisite" as in the first entry). After this, the regex finds the first line break and gets everything after it until it finds the next course #. The 3 fields would be a course number, a course title, and a course description. The course number and title are on the same line always and the description is everything beneath.

Sample end result would contain 3 fields which I'm guessing could be stored into 3 arrays:

"ARTA215","ADVANCED LIFE DRAWING (3 Cr) (2:2)  + Studio 1 hr.","This advanced study in drawing with the life .... Prerequisite: ARTA150 Lab Fee Required"

Like I said, it's quite a nightmare, but I want to automate this instead of cleaning up after someone each time the file is generated.

Answer 1

Consider the following example that depends on blocks of course descriptions being completely contained within what Perl considers to be paragraphs:

#! /usr/bin/perl

$/ = "";
my $record_start = qr/
  ^            # starting with a newline
  \s*          # allow optional leading whitespace
  ([A-Z]+\d+)  # capture course tag, e.g., ARTA215
  \s+          # separating whitespace
  (.+?)        # course title on rest of line
  \s*\n        # consume trailing whitespace
/mx;

while (<>) {
  my($course,$title);
  if (s/\A$record_start//) {
    ($course,$title) = ($1,$2);
  }
  elsif (s/(?s:^.+?)(?=$record_start)//) {
    redo;
  }
  else {
    next;
  }

  my $desc;
  die unless s/^(.+?)(?=$record_start|\s*$)//s;
  (my $desc = $1) =~ s/\s*\n\s*/ /g;
  for ($course, $title, $desc) {
    s/^\s+//; s/\s+$//; s/\s+/ /g;
  }
  print join("," => map qq{"$_"} => $course, $title, $desc), "\n";
  redo if $_;
}

When fed your sample input, it outputs

"ARTA215","ADVANCED LIFE DRAWING (3 Cr) (2:2) + Studio 1 hr.","This advanced study in drawing with the life .... Prerequisite: ARTA150 Lab Fee Required"
"ARTA220","CERAMICS II (3 Cr) (2:2) + Studio 1 hr.","This course affords the student the opportunity to ex... Lab Fee Required"
"ARTA250","SPECIAL TOPICS IN ART","This course focuses on selected topic...."
"ARTA260","PORTFOLIO DEVELOPMENT (3 Cr) (3:0)","The purpose of this course is to pre...."
"BIOS010","INTRODUCTION TO BIOLOGICAL CONCEPTS (3IC) (2:2)","This course is a preparatory course designed to familiarize the begi...."
"BIOS101","GENERAL BIOLOGY (4 Cr) (3:3)","This course introduces the student to the principles of mo... Lab Fee Required"
"BIOS102","INTRODUCTION TO HUMAN BIOLOGY (4 Cr) (3:3)","This course is an introd.... Lab Fee Required"

Answer 2

regex may be overkill for this, as the pattern appears to be simply:

[course]
[description]
{Prerequisites}
{Lab Fee Required}

where [course] is composed of

[course#] [course title] {# Cr} [etc/don't care]

and the course# is just the first 7 characters.

so you can scan the file with a simple state-machine, something like:

//NOTE: THIS IS PSEUDOCODE
s = 'parseCourse'
f = openFile(blah)
l = readLine(f)
while (l) {
    if (s=='parseCourse') {
        if (l.StartsWith('Prerequisite:')) {
            extractPrerequisite(l)
        }
        else if (l.StartsWith('Lab Fee Required')) {
            extractLabFeeRequired(l)
        }
        else {
            extractCourseInfo(l)
            s='parseDescription'
        }
    }
    else if (s=='parseDescription') {
        extractDescription(l)
        s='parseCourse'
    }
    l = readLine(f)
}
close(f)

Answer 3

Try:

my $course;
my @courses;
while ( my $line = <$input_handle> ) {
    if ( $line =~ /^([A-Z]{4}\d+)\s+([A-Z]{2}.*)/ ) {
        $course = [ "$1", "$2" ];
        push @courses, $course;
    }
    elsif ($course) {
        $course->[2] .= $line
    }
    else {
        # garbage before first course in file
        next
    }
}

This produces an array of arrays, as I understand you want. It would make more sense to me to have an array of hashes or even a hash of hashes.

Answer 4

I had roughly the same idea as Gbacon to use paragraph mode since that will neatly chunk the file into records for you. He typed faster, but I wrote one, so here's my crack at it:

#!/usr/bin/env perl
use strict;
use warnings;

local $/ = "";

my @items;
while (<>) {
  my( $course, $description ) = (split /\n/, $_)[0, 1];
  my( $course_id, $name ) = ($course =~ m/^(\w+)\s+(.*)$/);
  push @items, [ $course_id, $name, $description ];
}

for my $record (@items) {
  print "Course id: ", $record->[0], "\n";
  print "Name and credits: ", $record->[1], "\n";
  print "Description: ", $record->[2], "\n";
}

As Ysth points out in a comment on Gbacon's answer, paragraph mode may not work here. If not, never mind.

Answer 5

#!/usr/bin/perl
$/ = "\n\n";
$FS = "\n";
$, = ',';
while (<>) {
    chomp;
    @F = split($FS, $_);
    print join($,,@F) ."\n";
}