# plugin which processes an the BBC Sound archive exported in an ASCII format package BRSPlug; use BasPlug; use ghtml; sub BEGIN { @ISA = ('BasPlug'); unshift (@INC, "$ENV{'GSDLCOLLECTDIR'}/perllib"); } %Exclude = (); # Note: sext is short for scrollable text #field_id label disp_type crit_type width height brs_para #---------------------------------------------------------------- #10 sport prdcr text text 30 1 T006 #1 text sext text 40 16 TEXT #16 scol ref text text text 30 1 SCOL #19 date text date 10 1 D001 #25 Item title text text 20 1 T001 #26 B/W Seqs text text 30 1 S001 #27 Medium text text 30 1 S002 #28 shot type text text 30 1 S003 #29 B/W Prog/Item text text 30 1 S004 #30 Seqs text text 10 1 S005 #31 Format text text 30 1 S006 #32 prog/item text text 30 1 S007 #35 reg libno text text 30 1 S008 #36 reg tape no text text 30 1 S009 #37 C Indicator text text 30 1 S010 #38 C Holder text text 30 1 T002 #39 cprd ind text text 30 1 S011 #40 cprd name text text 30 1 T003 #44 reference sext text 30 5 R001 #49 prog num text text 10 1 PRNO #59 news title text text 30 1 T005 #65 cat num text text 10 1 CATN #72 Record number text text 30 1 T007 #73 rx_date text date 10 1 S013 #74 Music performer text text 30 2 T008 #75 Composer text text 30 2 T009 #76 mono/stereo text text 30 1 S014 #77 music medium text text 30 1 S015 #82 Sound Tech text text 30 1 S016 #83 Music publisher text text 30 1 S017 #84 music tape text text 30 1 T012 #89 catalogue text text 3 1 CODE #104 subcat text text 10 1 SUBC #106 prog title text text 40 1 TTLE #109 screen type text text 10 1 DOCT #110 stock title text text 30 1 T013 #113 stock ln 4 text text 30 1 T015 #114 stock lib 1 text text 30 1 S020 #115 stock lib 2 text text 30 1 S021 #---------------------------------------------------------------- my @brs_field_table = ( { field_name => "TTLE", field_id => 106, label => "Prog title", disp_type => "text", crit_type => "text", width => 40, height => 1 }, { field_name => "T001", field_id => 25, label => "Item title", disp_type => "text", crit_type => "text", width => 20, height => 1 }, { field_name => "T005", field_id => 59, label => "News title", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "T013", field_id => 110, label => "Stock title", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "T007", field_id => 72, label => "Record number", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "TEXT", field_id => 1, label => "Text", disp_type => "scrl", crit_type => "text", width => 40, height => 16 }, { field_name => "T006", field_id => 10, label => "Sport prdcr", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "SCOL", field_id => 16, label => "Scol ref text", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "D001", field_id => 19, label => "Date", disp_type => "text", crit_type => "date", width => 10, height => 1 }, { field_name => "S001", field_id => 26, label => "B/W Seqs", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S002", field_id => 27, label => "Medium", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S003", field_id => 28, label => "Shot type", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S004", field_id => 29, label => "B/W Prog/Item", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S005", field_id => 30, label => "Seqs", disp_type => "text", crit_type => "text", width => 10, height => 1 }, { field_name => "S006", field_id => 31, label => "Format", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S007", field_id => 32, label => "Prog/item", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S008", field_id => 35, label => "Reg libno", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S009", field_id => 36, label => "Reg tape no", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S010", field_id => 37, label => "C Indicator", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "T002", field_id => 38, label => "C Holder", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S011", field_id => 39, label => "Cprd ind", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "T003", field_id => 40, label => "Cprd name", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "R001", field_id => 44, label => "Reference", disp_type => "scrl", crit_type => "text", width => 30, height => 5 }, { field_name => "PRNO", field_id => 49, label => "Prog num", disp_type => "text", crit_type => "text", width => 10, height => 1 }, { field_name => "CATN", field_id => 65, label => "Cat num", disp_type => "text", crit_type => "text", width => 10, height => 1 }, { field_name => "S013", field_id => 73, label => "Rx_date", disp_type => "text", crit_type => "date", width => 10, height => 1 }, { field_name => "T008", field_id => 74, label => "Music performer", disp_type => "text", crit_type => "text", width => 30, height => 2 }, { field_name => "T009", field_id => 75, label => "Composer", disp_type => "text", crit_type => "text", width => 30, height => 2 }, { field_name => "S014", field_id => 76, label => "Mono/stereo", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S015", field_id => 77, label => "Music medium", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S016", field_id => 82, label => "Sound Tech", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S017", field_id => 83, label => "Music publisher", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "T012", field_id => 84, label => "Music tape", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "CODE", field_id => 89, label => "Catalogue", disp_type => "text", crit_type => "text", width => 3, height => 1 }, { field_name => "SUBC", field_id => 104, label => "Subcat", disp_type => "text", crit_type => "text", width => 10, height => 1 }, { field_name => "DOCT", field_id => 109, label => "Screen type", disp_type => "text", crit_type => "text", width => 10, height => 1 }, { field_name => "T015", field_id => 113, label => "Stock ln 4", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S020", field_id => 114, label => "Stock lib 1", disp_type => "text", crit_type => "text", width => 30, height => 1 }, { field_name => "S021", field_id => 115, label => "Stock lib 2", disp_type => "text", crit_type => "text", width => 30, height => 1 } ); my @brs_title_list = ("TTLE", "T001", "T005", "T013", "T007", "RFTI"); my %cat_num_list = (); sub new { my ($class) = @_; my $self = new BasPlug ($class, @_); return bless $self, $class; } sub get_default_process_exp { my $self = shift (@_); # return q^(?i)\.brs$^; return q^b.+^; } my $brs_doc_count = 0; my $brs_dot_count = 0; my $brs_line_no = 0; sub brs_error { my ($file, $mess, $outhandle) = @_; print $outhandle "Malformed BRS recorded at line $brs_line_no in $file:\n"; print $outhandle " $mess\n"; } sub read_brs_record { my ($recordref, $file, $outhandle) = @_; my $extra_trigger = '\s*>'; my $text_divider = "-" x 78; my $text_end = '^\.\.[^:]+:$'; # Print "." to signify processing if enough records have been read in $brs_doc_count++; if (($brs_doc_count % 10) == 0) { print $outhandle "."; $brs_dot_count++; print $outhandle "\n" if (($brs_dot_count % 80) == 0); } my $brs_rec = undef; my $line = undef; # read in the record my @brs_lines = split /\n/, $$recordref; while (scalar(@brs_lines)>0) { $line = shift(@brs_lines); $line =~ s/\cM//g; $brs_line_no++; if ($line =~ m/^\.\.([^:]+):$/) { my $field_name = $1; if ($field_name eq "TEXT") { my $text_above = ""; my $text_extra = ""; my $text_below = ""; my $add_mode = "above"; while (scalar(@brs_lines)>0) { last if ($brs_lines[0] =~ m/$text_end/); $line = shift(@brs_lines); $brs_line_no++; if ($line =~ m/^$text_divider/) { $add_mode = "below"; next; } if ($line =~ m/^$extra_trigger/) { $text_extra .= "$line\n"; $add_mode = "below"; next; } if ($line =~ m/^\.\.[^:]+:/) { if ($line =~ m/^\.\.TEXT/) { $add_mode = "above"; next; } else { brs_error($file, "Unexpected field $line", $outhandle); # put field name back unshift(@brs_lines, $line); $brs_line_no--; last; } } if ($line !~ m/^\s+(-){10,}$/) { if ($add_mode eq "above") { $text_above .= "$line "; } else { $text_below .= "$line "; } } } $brs_rec->{TEXTA} .= $text_above if ($text_above ne ""); $brs_rec->{TEXTB} .= $text_below if ($text_below ne ""); $brs_rec->{TEXTE} .= $text_extra if ($text_extra ne ""); } elsif ($field_name =~ /^RF/) { # read zz fields until end of record while (scalar(@brs_lines)>0) { my $line_ahead = $brs_lines[0]; last if ($line_ahead =~ m/^\.\.[^:]+:$/); $line = shift(@brs_lines); $brs_line_no++; if (!defined($brs_rec->{$field_name})) { $brs_rec->{$field_name} = [$line]; } else { push(@{$brs_rec->{$field_name}},$line); } } } else { my $field_entry = ""; while ($brs_lines[0] !~ m/^\.\.[^:]+:$/) { $field_entry .= shift(@brs_lines); $brs_line_no++; last if (scalar(@brs_lines)==0); } if (!defined($brs_rec->{$field_name})) { $brs_rec->{$field_name} = $field_entry; } else { brs_error($file, "$field_name already defined.", $outhandle); } } } else { brs_error($file, "Malformed field: $line.", $outhandle); } } # format the programme number if required &format_prognum($brs_rec); return ($brs_rec); } my $brs_processed_count = 0; sub brs_full_record_in_html { my ($doc_obj,$cursection,$brs_rec) = @_; my $html_table = ""; my $table_line = ""; my $cell_count = 0; my $long_lines = ""; my $i; for ($i=0; $i<=$#brs_field_table; $i++) { my $field_name = $brs_field_table[$i]->{'field_name'}; if (defined($brs_rec->{$field_name})) { my $field_label = $brs_field_table[$i]->{'label'}; my $field_value = $brs_rec->{$field_name}; # these fields get their own line if ($field_label =~ /^(Prog|Item|News|Stock) title$/) { my $safe_value = $field_value; &ghtml::urlsafe ($safe_value); $long_lines .= "
Additional:
$zz: | $name |
$zz: | $name |
$zz: | $name |