# # bibliography package for Perl # # output routines # # Dana Jacobsen (dana@acm.org) # 12 March 1996 (last modified 12 March 1996) # # This is the new output scheme. It uses a style generated by genmod, and # designated by the style=... option. # # This is going to be a bit more complicated than it is right now. We will # want to handle open and close ourselves, and deal with lists. # One lingering problem is that some charsets will have a bit more to deal # with than others. For instance, for HTML, we want to have a more specific # header and trailer. # package bp_output; $version = "output (dj 12 mar 96)"; ###### &bib'reg_format( 'output', # name 'out', # short name 'bp_output', # package name 'none', # default character set 'suffix is out', # functions 'open', 'close', 'write', 'clear', 'options', 'read is unsupported', 'explode', 'implode', 'tocanon is unsupported', 'fromcanon', ); ###### %styles = (); $opt_style = 'generic'; &load_style($opt_style); $opt_full_document = 1; # This keeps track of whether we're writing a header or not. It has three # values: # -1 means don't output headers or trailers # 0 means it's open but nothing written yet # 1 means we've written the header already %file_modes = (); ###### sub options { local($opt) = @_; &bib'panic("output options called with no arguments!") unless defined $opt; &bib'debugs("parsing output option '$opt'", 64); if ($opt !~ /=/) { # Assume this is a style being asked for. $opt =~ s/^/style=/; } local($_, $val) = split(/\s*=\s*/, $opt, 2); &bib'debugs("option split: $_ = $val", 8); /^style$/ && do { return &load_style($val); }; /^full$/ && do { $opt_full_document = 1; return 1; }; /^list$/ && do { $opt_full_document = 0; return 1; }; undef; } ###### sub load_style { local($style) = @_; # For some reason, $style gets undefined after the eval. So we store # it in the global $opt_style. $opt_style = $style; $conv_func = "conv_$opt_style"; return 1 if defined $styles{$opt_style}; &bib'debugs("loading output style $opt_style...", 1024); $func = "require \"${bib'glb_bpprefix}s-$opt_style.pl\";"; eval $func; if ($@) { $conv_func = 'conv_generic'; if ($@ =~ /^Can't locate ${bib'glb_bpprefix}/) { return &bib'goterror("style $opt_style is not supported."); } return &bib'goterror("error in style $opt_style: $@", "module"); } $styles{$opt_style} = 1; 1; } ###### sub implode { local(%rec) = @_; return $rec{'TEXT'} if defined $rec{'TEXT'}; return &bib'goterror("No TEXT entry in record"); } ###### sub explode { local(%rec); $rec{'TEXT'} = $_[0]; %rec; } ###### sub fromcanon { local(%entry) = @_; local(%rec) = (); local($ent) = ''; # We do the conversion here rather than in implode because we can put # escape characters and meta characters in the style without worrying # about which character set is being used. # Well, almost. We do care if we're using HTML, because we want a number # of special things done for it. As of 0.2.2, we have glb_current_cset # set for us for fromcanon. if ($bib'glb_current_cset eq 'html') { #$ent = "${bib'cs_meta}1100\n"; if (defined $entry{'Source'}) { local($url, $title); $url = $entry{'Source'}; $url =~ s/<(.*)>/$1/; $url =~ s/^url:\s*(.*)/$1/i; if ($url =~ /^\w+:\/\//) { $title = $entry{'Title'}; $entry{'Title'} = "${bib'cs_meta}2200" . "${bib'cs_meta}2300" . $url . "${bib'cs_meta}2310" . $title . "${bib'cs_meta}2210"; } } } $ent .= &$conv_func(%entry); #$ent =~ s/\s\s+/ /g; $ent =~ s/$bib'cs_sep/ ; /go; $rec{'TEXT'} = $ent; %rec; } ###### sub open { local($file) = @_; local($name, $mode); &panic("output open called with no arguments") unless defined $file; # get the name and mode if ($file =~ /^>>(.*)/) { $mode = 'append'; $name = $1; # XXXXX we assume that we're in the middle of a list already. # We also assume we don't want any trailers written. # I think this is correct. $file_modes{$name} = -1 unless defined $file_modes{$name}; } elsif ($file =~ /^>(.*)/) { $mode = 'write'; $name = $1; #print STDERR "name: $file"; #print STDERR ", oldmode: $file_modes{$name}" if defined $file_modes{$name}; &close($file) if defined $file_modes{$name}; $file_modes{$name} = 0; #print STDERR ", mode: $file_modes{$name}\n"; } else { $mode = 'read'; $name = $file; $file_modes{$name} = -1 unless defined $file_modes{$name}; } $file_modes{$name} = -1 unless $opt_full_document; if ($mode eq 'write') { &bib'debugs("output write", 128, 'module'); return &bib'goterror("Can't open file $file") unless open($bib'glb_current_fh, $file); return $bib'glb_current_fmt; } elsif ($mode eq 'append') { &bib'debugs("output append", 128, 'module'); return &bib'goterror("Can't open file $file") unless open($bib'glb_current_fh, $file); # XXXXX Is there anything special we should do here? return $bib'glb_current_fmt; } else { &bib'debugs("output read", 128, 'module'); # XXXXX What exactly would this mean? Skip headers of some kind? return $bib'glb_current_fmt if open($bib'glb_current_fh, $file); &bib'goterror("Can't open file $file"); } } ###### sub close { local($file) = @_; &panic("output close called with no arguments") unless defined $file; if ( $opt_full_document && (defined $file_modes{$file}) && ($file_modes{$file} == 1) && (defined $tailstr{$bib'glb_current_cset}) ) { print $bib'glb_current_fh $tailstr{$bib'glb_current_cset}; } &bib'clear($file); close($bib'glb_current_fh); } ###### sub write { local($file, $out) = @_; local($outstr, $bibname); &panic("output write called with no arguments") unless defined $file; &panic("output write called with no output") unless defined $out; &bib'debugs("writing $file", 32); if ($file_modes{$file} == 0) { $file_modes{$file} = 1; if (defined $headstr{$bib'glb_current_cset}) { local($outstr, $bibname); $outstr = $headstr{$bib'glb_current_cset}; # XXXXX Why not use $file for bibname? if (defined $bib'glb_Ifilename) { $bibname = $bib'glb_Ifilename; } else { $bibname = ''; } # get the first two occurances of this. $outstr =~ s/Bibliography: =name=/Bibliography: $bibname/; $outstr =~ s/Bibliography: =name=/Bibliography: $bibname/; print $bib'glb_current_fh $outstr; } } print $bib'glb_current_fh ($out, "\n\n"); } ###### sub clear { local($file) = @_; undef $file_modes{$file}; 1; } ###### # # Headers and trailers for various character sets. # This ought to go into a style file of some kind. # %headstr = (); %tailstr = (); $headstr{'html'} =<<"EOH-HTML"; Bibliography: =name=

Bibliography: =name=

EOH-HTML $tailstr{'html'} =<<"EOT-HTML";
Created automatically by bp $bib'glb_version using module $version, style $opt_style.
EOT-HTML ####################### # end of package ####################### 1;