Refs.pm

   1 package SGMLS::Refs;
   2
   3 use Carp;
   4
   5 $version = '$Id: Refs.pm,v 1.5 1995/12/03 21:28:36 david Exp $';
   6
   7 =head1 NAME
   8
   9 SGMLS::Refs
  10
  11 =head1 SYNOPSIS
  12
  13   use SGMLS::Refs;
  14
  15 To create a new reference-manager object using the file "foo.refs":
  16
  17   my $refs = new SGMLS::Refs("foo.refs");
  18
  19 To create a new reference-manager object using the file "foo.refs" and
  20 logging changes to the file "foo.log":
  21
  22   my $refs = new SGMLS::Refs("foo.refs","foo.log");
  23
  24 To record a reference:
  25
  26   $refs->put("document title",$title);
  27
  28 To retrieve a reference:
  29
  30   $title = $refs->get("document title");
  31
  32 To return the number of references changed since the last run:
  33
  34   $num = $refs->changed;
  35
  36 To print a LaTeX-like warning if any references have changed:
  37
  38   $refs->warn;
  39
  40 =head1 DESCRIPTION
  41
  42 This library can be used together with the B<SGMLS> package to keep
  43 track of forward references from one run to another, like the B<LaTeX>
  44 C<.aux> files.  Each reference manager is an object which reads and
  45 then rewrites a file of perl source, with the file name provided by
  46 the caller.
  47
  48 Example:
  49
  50   # Start up the reference manager before the parse.
  51   sgml('start', sub { $refs = new SGMLS::Refs("foo.refs"); });
  52
  53   # Warn about any changed references at the end.
  54   sgml('end', sub { $refs->warn; });
  55
  56   # Look up the title from the last parse, if available.
  57   sgml('<div>', sub {
  58     my $element = shift;
  59     my $id = $element->attribute(ID)->value;
  60     my $title = $refs->get("title:$id") || "[no title available]";
  61
  62     $current_div_id = $id;
  63
  64     output "\\section{$title}\n\n";
  65   });
  66
  67
  68   # Save the title for the next parse.
  69   sgml('<head>', sub { push_output('string'); });
  70   sgml('</head>', sub {
  71     my $title = pop_output();
  72     my $id = $current_div_id;
  73
  74     $refs->put("title:$id",$title);
  75   });
  76
  77
  78 =head1 AUTHOR AND COPYRIGHT
  79
  80 Copyright 1994 and 1995 by David Megginson,
  81 C<dmeggins@aix1.uottawa.ca>.  Distributed under the terms of the Gnu
  82 General Public License (version 2, 1991) -- see the file C<COPYING>
  83 which is included in the B<SGMLS.pm> distribution.
  84
  85
  86 =head1 SEE ALSO:
  87
  88 L<SGMLS>, L<SGMLS::Output>.
  89
  90 =cut
  91
  92 #
  93 # Create a new instance of a reference manager.  The first argument is
  94 # the filename for the database, and the second (if present) is a
  95 # filename for logging changes.
  96 #
  97 sub new {
  98     my ($class,$filename,$logname) = (@_);
  99     my $self = {};
 100     my $handle = generate_handle();
 101     my $loghandle = generate_handle() if $logname;
 102     my $oldRS = $/;             # Save old record separator.
 103
 104     # Read the current contents of the reference file (if any).
 105     if (open($handle,"<$filename")) {
 106         $/ = 0777;
 107         $self->{'refs'} = eval <$handle> || {};
 108         close $handle;
 109     } else {
 110         $self->{'refs'} = {};
 111     }
 112
 113     # Open the reference file.
 114     open($handle,">$filename") || croak $@;
 115
 116     # Open the log file, if any.
 117     if ($logname) {
 118         open($loghandle,">$logname") || croak $@;
 119     }
 120
 121     # Note pertinent information.
 122     $self->{'change_count'} = 0;
 123     $self->{'handle'} = $handle;
 124     $self->{'loghandle'} = $loghandle;
 125     $self->{'filename'} = $filename;
 126     $self->{'logname'} = $logname;
 127
 128     $/ = $oldRS;                # Restore old record separator.
 129     return bless $self;
 130 }
 131
 132 #
 133 # Set a reference's value.  If the value is unchanged, don't do anything;
 134 # otherwise, note the change by counting it and (optionally) logging it
 135 # to the file handle provided when the object was created.
 136 #
 137 sub put {
 138     my ($self,$key,$value) = (@_);
 139     my $loghandle = $self->{'loghandle'};
 140     my $oldvalue = $self->{'refs'}->{$key};
 141
 142     if ($oldvalue ne $value) {
 143         $self->{'change_count'}++;
 144         if ($loghandle) {
 145             print $loghandle "\"$key\" changed from " .
 146
 147               "\"$oldvalue\" to \"$value\".\n";
 148         }
 149         $self->{'refs'}->{$key} = $value;
 150     }
 151
 152     return $oldvalue;
 153 }
 154
 155 #
 156 # Grab the value of a reference.
 157 #
 158 sub get {
 159     my ($self,$key) = (@_);
 160
 161     return $self->{'refs'}->{$key};
 162 }
 163
 164 #
 165 # Return the number of changed references.
 166 #
 167 sub changed {
 168     my $self = shift;
 169     return $self->{'changed_count'};
 170 }
 171
 172 #
 173 # Print a warning if any references have
 174 # changed (a la LaTeX -- so that the user knows that another pass is
 175 # necessary).  Return 1 if a warning has been printed, or 0 if it
 176 # was unnecessary.
 177 #
 178 sub warn {
 179     my $self = shift;
 180     my $count = $self->{'change_count'};
 181     my $filename = $self->{'filename'};
 182     my $plural = "references have";
 183
 184     $plural = "reference has" if $count == 1;
 185     if ($count > 0) {
 186         warn "SGMLS::Refs ($filename): $count $plural changed.\n";
 187         return 1;
 188     }
 189     return 0;
 190 }
 191
 192 sub DESTROY {
 193     my $self = shift;
 194     my $handle = $self->{'handle'};
 195
 196     close $self->{'loghandle'};
 197
 198     print $handle "{\n";
 199     foreach $key (keys %{$self->{'refs'}}) {
 200         my $value = $self->{'refs'}->{$key};
 201         $key =~ s/\\/\\\\/g;
 202         $key =~ s/'/\\'/g;
 203         $value =~ s/\\/\\\\/g;
 204         $value =~ s/'/\\'/g;
 205         print $handle "  '$key' => '$value',\n";
 206     }
 207     print $handle "  '' => ''\n}\n";
 208 }
 209
 210 $handle_counter = 1;
 211 sub generate_handle {
 212     return "Handle" . $handle_counter++;
 213 }
 214
 215 1;
 216