Ignore:
Timestamp:
2006-07-20T15:45:08+12:00 (18 years ago)
Author:
nzdl
Message:

Chi's changes from the last BBC build

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/bbc/collect/bbc/perllib/plugins/BRSPlug.pm

    r4647 r12265  
    1313}
    1414
     15my $bbc_collections_list =
     16    [{'name' => "all", # all collections
     17      'desc' => "{BRSPlug.bbc_collections.all}"},
     18     {'name' => "nsa", # National Sound Archive
     19      'desc' => "{BRSPlug.bbc_collections.nsa"},
     20     {'name' => "bfi", # Brisith File Institute
     21      'desc' => "{BRSPlug.bbc_collections.bfi"},
     22     {'name' => "bbcother", # BBC Other
     23      'desc' => "{BRSPlug.bbc_collections.bbcother"}];
     24
     25
     26my $arguments =
     27    [{ 'name' => "bbc_collections",
     28       'desc' => "{BRSPlug.bbc_collections}",
     29       #'type' => $bbc_collections_list,
     30       'type' => "string",
     31       'reqd' => "no",
     32       'deft' => "all"}];
     33
    1534%Exclude = ();
    1635
     36my $options = { 'name'     => "BRSPlug",
     37        'desc'     => "{BRSPlug.desc}",
     38        'abstract' => "yes",
     39        'inherits' => "no",
     40        'args'     => $arguments };
    1741
    1842# Note: sext is short for scrollable text
    … …  
    79103        disp_type  => "text",  crit_type  => "text",
    80104        width      => 30,      height     => 1       },
     105      { field_name => "RFTI",  field_id   => 116,  label => "RFTI",
     106        disp_type  => "text",  crit_type  => "text",
     107        width      => 30,      height     => 1       },
    81108      { field_name => "TEXT",  field_id   => 1,   label => "Text",
    82109        disp_type  => "scrl",  crit_type  => "text",
    83110    width      => 40,      height     => 16      },
    84 
    85111      { field_name => "T006",  field_id   => 10,  label => "Sport prdcr",
    86112        disp_type  => "text",  crit_type  => "text",
    … …  
    189215
    190216sub new {
    191     my ($class) = @_;
     217    my $class = shift (@_);
    192218    my $self = new BasPlug ($class, @_);
    193 
     219    $self->{'plugin_type'} = "BRSPlug";
     220
     221    # 14-05-02 To allow for proper inheritance of arguments - John Thompson
     222    my $option_list = $self->{'option_list'};
     223    push( @{$option_list}, $options );
     224   
     225    if (!parsargv::parse(\@_,
     226             q^bbc_collections/(all|nsa|bfi|bbcother)/^, \$self->{'bbc_collections'},
     227             "allow_extra_options")) {
     228   
     229    print STDERR "\nIncorrect options passed to BRSPlug, check your collect.cfg configuration file\n";
     230    $self->print_txt_usage("");  # Use default resource bundle
     231    die "\n";
     232    }
     233
     234    #my ($class) = @_;
     235    #my $self = new BasPlug ($class, @_);
     236   
    194237    return bless $self, $class;
    195238}
    … …  
    199242
    200243#    return q^(?i)\.brs$^;
    201     return q^b.+^;
     244    return q^TVRD.+^;
    202245}
    203246
    … …  
    220263    my $extra_trigger = '\s*>';
    221264    my $text_divider = "-" x 78;
    222     my $text_end = '^\.\.[^:]+:$';
    223 
     265    #my $text_end = '^\.\.[^:]+:$';
     266    my $meta_key = '^\.\.(\w+):$';
     267   
    224268    # Print "." to signify processing if enough records have been read in
    225269    $brs_doc_count++;
    … …  
    240284    {
    241285    $line = shift(@brs_lines);
     286   
    242287    $line =~ s/\cM//g;
    243288
    244289    $brs_line_no++;
    245290
    246     if  ($line =~ m/^\.\.([^:]+):$/)
     291#   if  ($line =~ m/^\.\.([^:]+):$/)
     292    if  ($line =~ m/$meta_key/)
    247293    {
    248294        my $field_name = $1;
    … …  
    258304        while (scalar(@brs_lines)>0)
    259305        {
    260             last if ($brs_lines[0] =~ m/$text_end/);
    261 
     306           
     307            last if ($brs_lines[0] =~ m/$meta_key/);
     308           
     309           
    262310            $line = shift(@brs_lines);
     311
     312
    263313            $brs_line_no++;
    264314           
    … …  
    275325            next;
    276326            }
    277            
    278             if ($line =~ m/^\.\.[^:]+:/)
     327           
     328            if ($line =~ m/$meta_key/)
     329            #if ($line =~ m/^\.\.[^:]+:/)
    279330            {
    280331            if ($line =~ m/^\.\.TEXT/)
    … …  
    282333                $add_mode = "above";
    283334                next;
    284             }
     335            } 
    285336            else
    286337            {
    … …  
    312363        elsif ($field_name =~ /^RF/)
    313364        {
     365        # deal with the field name start with RF, eg. RFTI,RFAN, RFAB...
    314366        # read zz fields until end of record
    315367           
    … …  
    317369        {
    318370            my $line_ahead = $brs_lines[0];
    319             last if ($line_ahead =~ m/^\.\.[^:]+:$/);
    320                    
     371            #last if ($line_ahead =~ m/^\.\.[^:]+:$/);
     372            last if ($line_ahead =~ m/$meta_key/);         
    321373            $line = shift(@brs_lines);
    322374            $brs_line_no++;
    323                
     375            #if (!defined($brs_rec->{$field_name}))
     376            #{
     377            #$brs_rec->{$field_name} = [$line];
     378            #}
     379            #else
     380            #{
     381            #push(@{$brs_rec->{$field_name}},$line);
     382            #}
     383                       
    324384            if (!defined($brs_rec->{$field_name}))
    325385            {
    326             $brs_rec->{$field_name} = [$line];
     386            $brs_rec->{$field_name} = (); #[$line];
    327387            }
    328             else
    329             {
    330             push(@{$brs_rec->{$field_name}},$line);
    331             }
     388            push(@{$brs_rec->{$field_name}},$line);
    332389        }
    333390        }
    … …  
    335392        {
    336393        my $field_entry = "";
    337         while ($brs_lines[0] !~ m/^\.\.[^:]+:$/)
     394        #while ($brs_lines[0] !~ m/^\.\.[^:]+:$/)
     395        while ($brs_lines[0] !~ m/$meta_key/)
    338396        {
    339397            $field_entry .= shift(@brs_lines);
    … …  
    379437    {
    380438    my $field_name = $brs_field_table[$i]->{'field_name'};
     439
    381440    if (defined($brs_rec->{$field_name}))
    382441    {
    … …  
    390449        $long_lines .= "<tr valign=top><td><b>$field_label:</b></td><td colspan=5>";
    391450        $long_lines .= "<a href=\"_httpquerytitle_&q=$safe_value\">$field_value</a></td></tr>\n";
    392         $long_lines .= "$field_value</td></tr>\n";
    393        
     451        $long_lines .= "$field_value </td></tr>\n";
    394452        } else {
    395453       
    … …  
    427485            $field_value = "<a href=\"_httpqueryzzabn_&q=$safe_value\">$field_value</a>";
    428486        }
    429        
     487        if ($field_label =~ /^(RFTI)/){
     488            $field_value = join(" ",@{$brs_rec->{'RFTI'}});
     489            #print STDERR "**** $field_label, $field_value\n";
     490        }
    430491        $table_line .= "<td><b>$field_label:</b></td><td>$field_value</td>\n";
    431492        }
    … …  
    445506sub process_brs_record
    446507{
     508    my $self = shift (@_);
     509
    447510    my ($processor, $brs_rec, $file, $outhandle) = @_;
    448511
    449512    if (defined($brs_rec))
    450513    {
    451 
    452514    # only include those records in the chosen subcats - these lines
    453515    # should be commented out to build the entire collection
    454516
    455     # National Sound Archive collection
    456 #   if (!defined ($brs_rec->{'SUBC'}) ||
    457 #       $brs_rec->{'SUBC'} !~ /^(RADCOMP|RADIOX|RADPROG|RADNEWS|BDSPROG|UNCATRAD|RADIOREF|WILDSOUND)$/) {
    458 #       return;
    459 #   }
    460 
     517    # National Sound Archive collection-Stephan
     518    #if (!defined ($brs_rec->{'SUBC'}) ||
     519    #    $brs_rec->{'SUBC'} !~ /^(RADCOMP|RADIOX|RADPROG|RADNEWS|BDSPROG|UNCATRAD|RADIOREF|WILDSOUND)$/) {
     520    #    return;
     521    #}
     522   
    461523    # British Film Institute collection
    462 #   if (!defined ($brs_rec->{'SUBC'}) ||
    463 #       $brs_rec->{'SUBC'} !~ /^(LONPROG|NEWS)$/) {
    464 #       return;
    465 #   }
    466 
     524    #if (!defined ($brs_rec->{'SUBC'}) ||
     525    #    $brs_rec->{'SUBC'} !~ /^(LONPROG|NEWS)$/) {
     526    #    return;
     527    #}
     528   
    467529    # "the rest" collection
    468     if (!defined ($brs_rec->{'SUBC'}) ||
    469         $brs_rec->{'SUBC'} =~ /^(LONPROG|NEWS|RADCOMP|RADIOX|RADPROG|RADNEWS|BDSPROG|UNCATRAD|RADIOREF|WILDSOUND)$/) {
    470         return;
     530    #if (!defined ($brs_rec->{'SUBC'}) ||
     531    #    $brs_rec->{'SUBC'} =~ /^(LONPROG|NEWS|RADCOMP|RADIOX|RADPROG|RADNEWS|BDSPROG|UNCATRAD|RADIOREF|WILDSOUND)$/) {
     532    #    return;
     533    #}
     534    #}
     535   
     536    # modified Chi-Yu Huang
     537    if (defined $self->{'bbc_collections'}){
     538        # National Sound Archive collection
     539        if ($self->{'bbc_collections'} eq "nsa"){
     540        #print STDERR "***This is NSA collections\n";
     541        if (!defined ($brs_rec->{'SUBC'}) ||
     542            $brs_rec->{'SUBC'} !~ /^(RADCOMP|RADIOX|RADPROG|RADNEWS|BDSPROG|UNCATRAD|RADIOREF|WILDSOUND)$/) {
     543            return;
     544        }
     545        }
     546        elsif ($self->{'bbc_collections'} eq "bfi"){
     547        print STDERR "***This is BFI collections\n";
     548        # British Film Institute collection
     549        if (!defined ($brs_rec->{'SUBC'}) ||
     550            $brs_rec->{'SUBC'} !~ /^(LONPROG|NEWS)$/) {
     551            return;
     552        }
     553        }
     554        elsif ($self->{'bbc_collections'} eq "bbcother"){
     555        #print STDERR "*** This is bbc Other collections\n";
     556        # "the rest" collection
     557        if (!defined ($brs_rec->{'SUBC'}) ||
     558            $brs_rec->{'SUBC'} =~ /^(LONPROG|NEWS|RADCOMP|RADIOX|RADPROG|RADNEWS|BDSPROG|UNCATRAD|RADIOREF|WILDSOUND)$/) {
     559            return;
     560        }
     561        } else {
     562        # build the whole collections
     563        #print STDERR "*** This is to build the whole collection\n";
     564        }
     565    } else {
     566        #build the whole collections
    471567    }
    472568
    … …  
    500596        else
    501597        {
    502             $title =  $brs_rec->{$pot_title};
    503         }
     598            if ($pot_title =~ /^RF/){
     599            $title = join (" ", @{$brs_rec->{$pot_title}});
     600            } else{
     601            $title = $brs_rec->{$pot_title};
     602            }
     603            #$title = $brs_rec->{$pot_title};
     604        }
     605
     606        #print STDERR "*** What is the title=$title\n";
    504607
    505608        my $tl_ref = $doc_obj->get_metadata ($cursection, "Title");
    … …  
    589692        $doc_obj->add_utf8_metadata ($cursection, "zzabn", $zzabn);
    590693    }
    591 
     694   
    592695    if (defined($brs_rec->{'RFN'}))
    593696    {
    … …  
    766869    next if $record !~ /\w/; # first record will be empty
    767870    my $brs_rec = &read_brs_record(\$record, $file, $self->{'outhandle'});
    768     &process_brs_record ($processor, $brs_rec, $file, $self->{'outhandle'});
     871    &process_brs_record ($self, $processor, $brs_rec, $file, $self->{'outhandle'});
    769872    }
     873   
     874    $self->{'num_processed'} += $brs_processed_count;
    770875
    771876    print $outhandle "\nNumber of BRS records = $brs_doc_count\n";
Note: See TracChangeset for help on using the changeset viewer.