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