1 2 3# = HISTORY SECTION ===================================================================== 4 5# --------------------------------------------------------------------------------------- 6# version | date | author | changes 7# --------------------------------------------------------------------------------------- 8# 0.03 |18.08.2003| JSTENZEL | new method generic(); 9# |05.05.2004| JSTENZEL | anchors now store the absolute number of their page, 10# | | | (which changes the results of query() from scalar string 11# | | | to [$headline, $page]!; 12# |12.09.2004| JSTENZEL | using the portable fields::new(); 13# |16.09.2004| JSTENZEL | objects declared as typed lexicals now; 14# 0.02 |< 14.04.02| JSTENZEL | new methods checkpoint() and reportNew(); 15# |19.04.2002| JSTENZEL | adapted the construction of reportNew()'s return 16# | | | value construction to certainly reply a hash ref.; 17# 0.01 |11.10.2001| JSTENZEL | new. 18# --------------------------------------------------------------------------------------- 19 20# = POD SECTION ========================================================================= 21 22=head1 NAME 23 24B<PerlPoint::Anchors> - simple anchor collection class 25 26=head1 VERSION 27 28This manual describes version B<0.03>. 29 30=head1 SYNOPSIS 31 32 # make a new object 33 my $anchors=new PerlPoint::Anchors; 34 35 # register an anchor 36 $anchors->add('page number', '500'); 37 38 # check an anchor for being known 39 ... if $anchors->query('page number'); 40 41 # get a list of all registered anchors 42 my %regAnchors=%{$anchors->query}; 43 44 45=head1 DESCRIPTION 46 47Anchors are no part of the PerlPoint language definition, but used by various tags 48which either define or reference them. To support those tags, this simple collection 49class was implemented. It provides a consistent and general interface for dealing 50with anchors. 51 52By using the module, one can register an anchor together with a value and query 53these data later, to check if a certain anchor was already registered or to access 54the anchor related value. A value can be any valid Perl data. Additionally, the 55complete collection can be requested. 56 57 58=head1 METHODS 59 60=cut 61 62 63 64 65# check perl version 66require 5.00503; 67 68# = PACKAGE SECTION (internal helper package) ========================================== 69 70# declare package 71package PerlPoint::Anchors; 72 73# declare package version 74$VERSION=0.03; 75 76 77 78# = PRAGMA SECTION ======================================================================= 79 80# set pragmata 81use strict; 82 83# declare attributes 84use fields qw(anchors logMode newAnchors genericPrefix generator); 85 86 87 88# = LIBRARY SECTION ====================================================================== 89 90# load modules 91use Carp; 92 93 94# = CODE SECTION ========================================================================= 95 96 97=pod 98 99=head2 new() 100 101The constructor builds and prepares a new collection object. You may 102have more than one object at a certain time, they work independently. 103 104B<Parameters:> 105 106=over 4 107 108=item class 109 110The class name. 111 112=item class 113 114An optional prefix for generic anchor names. Defaults to "__GANCHOR__". 115 116=back 117 118B<Returns:> the new object. 119 120B<Example:> 121 122 my $anchors=new PerlPoint::Anchors; 123 124=cut 125sub new 126 { 127 # get parameter 128 my ($class, $genericPrefix)=@_; 129 130 # check parameters 131 confess "[BUG] Missing class name.\n" unless $class; 132 133 # build object 134 my $me=fields::new($class); 135 136 # set logging up 137 $me->checkpoint(0); 138 139 # init generator of anchor generic anchor names 140 $me->{generator}=0; 141 $me->{genericPrefix}=defined $genericPrefix ? $genericPrefix : '__GANCHOR__'; 142 143 # supply new object 144 $me; 145 } 146 147 148 149=pod 150 151=head2 add() 152 153Registers a new anchor together with a related value. The value is optional 154and might be whatever data Perl allows to store via a scalar. 155 156B<Parameters:> 157 158=over 4 159 160=item object 161 162An object made by C<new>. 163 164=item name 165 166The anchors name. This is a string. It is I<not> checked if the name was 167already registered before, an existing entry will be overwritten quietly. 168 169=item value 170 171Data related to the anchor. This is an scalar. The object does nothing 172with it then storing and providing it on request, so it is up to the user 173what kind of data is collected here. 174 175=item page 176 177The absolute number of the page the anchor is located in. This counting starts 178with 1 for the first chapter and continues with 2, 3 etc. regardless of chapter levels. 179 180=back 181 182B<Returns:> the object. 183 184B<Example:> 185 186 $anchors->add('new anchor', [{new=>'anchor'}], 17); 187 188=cut 189sub add 190 { 191 # get and check parameters 192 ((my __PACKAGE__ $me), my ($name, $value, $page))=@_; 193 confess "[BUG] Missing object parameter.\n" unless $me; 194 confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and ref $me eq __PACKAGE__; 195 confess "[BUG] Missing anchor name parameter.\n" unless defined $name; 196 confess "[BUG] Missing page number parameter.\n" unless defined $page; 197 198 # add new anchor (should we check overwriting?) 199 $me->{anchors}{$name}=[defined $value ? $value : undef, $page]; 200 201 # update anchor log, if necessary 202 $me->{newAnchors}{$name}=$me->{anchors}{$name} if $me->{logMode}; 203 204 # supply modified object 205 $me; 206 } 207 208 209 210=pod 211 212=head2 query() 213 214Requests anchors from the collection. This can be either the complete 215collection or just one entry. The method can be used both to check 216if an anchor was registered and to get its value. 217 218 219B<Parameters:> 220 221=over 4 222 223=item object 224 225An object made by C<new()>. 226 227=item name 228 229The name of the anchor of interest. 230 231This parameter is optional. 232 233=back 234 235B<Returns:> 236 237If no C<name> was passed, the complete collection is provided as a 238reference to a hash containing name-value/page-pairs. The referenced hash 239is the objects own hash used internally, so modifications will affect 240the object. 241 242If an anchor name was passed and this name was registered, a hash 243reference is provided as well (for reasons of consistency). The 244referenced hash is a I<copy> and contains the appropriate pair of 245anchor name and a reference to an array of its value and page. 246 247If an anchor name was passed and this name was I<not> registered, 248the method returns an undefined value. 249 250B<Examples:> 251 252 # check an anchor for being known 253 ... if $anchors->query('new anchor'); 254 255 # get the value of an anchor 256 if ($anchors->query('new anchor')) 257 {$value=$anchors->query('new anchor')->{'new anchor'};} 258 259 # get the collection 260 my %anchorHash=%{$anchors->query}; 261 262=cut 263sub query 264 { 265 # get and check parameters 266 ((my __PACKAGE__ $me), my $name)=@_; 267 confess "[BUG] Missing object parameter.\n" unless $me; 268 confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and ref $me eq __PACKAGE__; 269 270 # certain name of interest? 271 if (defined $name) 272 {return exists $me->{anchors}{$name} ? {$name=>$me->{anchors}{$name}} : undef;} 273 274 # ok, provide the complete list 275 %{$me->{anchors}} ? $me->{anchors} : undef; 276 } 277 278 279=pod 280 281=head2 checkpoint() 282 283Activates or deactivates logging of all anchors added after this call. 284By default, logging is switched off. 285 286The list of new anchors can be requested by a call of I<reportNew()>. 287 288Previous logs are I<reset> by a new call of C<checkpoint()>. 289 290B<Parameters:> 291 292=over 4 293 294=item object 295 296An object made by C<new>. 297 298=item logging mode 299 300Logging is activated by a true value, disabled otherwise. 301 302=back 303 304B<Returns:> the object. 305 306B<Example:> 307 308 $anchors->checkpoint; 309 310=cut 311sub checkpoint 312 { 313 # get and check parameters 314 ((my __PACKAGE__ $me), my $mode)=@_; 315 confess "[BUG] Missing object parameter.\n" unless $me; 316 confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and ref $me eq __PACKAGE__; 317 318 # reset log, flag logging state 319 $me->{newAnchors}={}; 320 $me->{logMode}=(defined $mode and $mode) ? 1 : 0; 321 322 # supply modified object 323 $me; 324 } 325 326 327=pod 328 329=head2 reportNew() 330 331Reports anchors added after the last recent call of C<checkpoint()>. 332If the C<checkpoint()> invokation disabled anchor logging, the result 333will by empty even if anchors I<were> added. 334 335Requesting the log does I<not> reset the logging data. To reset it, 336I<checkpoint()> needs to be called again. 337 338B<Parameters:> 339 340=over 4 341 342=item object 343 344An object made by C<new>. 345 346=back 347 348B<Returns:> A reference to a hash containing names and values of 349newly added anchors. The supplied hash can be modified without 350effect to the object. 351 352B<Example:> 353 354 my $newAnchorHash=$anchors->reportNew; 355 356=cut 357sub reportNew 358 { 359 # get and check parameters 360 (my __PACKAGE__ $me)=@_; 361 confess "[BUG] Missing object parameter.\n" unless $me; 362 confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and ref $me eq __PACKAGE__; 363 364 # supply a reference to a hash of added anchors (use a helper variable 365 # to enforce perl to recognize the hash reference constructor) 366 my $rc={%{$me->{newAnchors}}}; 367 $rc; 368 } 369 370 371=pod 372 373=head2 generic() 374 375Supplies a generic anchor name build according to the pattern /^<generic prefix>\d+$/ (with 376the <generic prefix> set up in the call of I<new()>) - so it is recommended not to use those 377names explicitly. 378 379B<Parameters:> 380 381=over 4 382 383=item object 384 385An object made by C<new>. 386 387=back 388 389B<Returns:> The new anchor name. 390 391B<Example:> 392 393 $anchors->add($anchors->generic, $data); 394 395=cut 396sub generic 397 { 398 # get and check parameters 399 (my __PACKAGE__ $me)=@_; 400 confess "[BUG] Missing object parameter.\n" unless $me; 401 confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and ref $me eq __PACKAGE__; 402 403 # suppply a new generic name 404 join('', $me->{genericPrefix}, ++$me->{generator}); 405 } 406 407 408 409 410# flag successful loading 4111; 412 413# = POD TRAILER SECTION ================================================================= 414 415=pod 416 417=head1 NOTES 418 419 420=head1 SEE ALSO 421 422=over 4 423 424=item B<PerlPoint::Parser> 425 426The parser module working on base of the declarations. 427 428 429=back 430 431 432=head1 SUPPORT 433 434A PerlPoint mailing list is set up to discuss usage, ideas, 435bugs, suggestions and translator development. To subscribe, 436please send an empty message to perlpoint-subscribe@perl.org. 437 438If you prefer, you can contact me via perl@jochen-stenzel.de 439as well. 440 441=head1 AUTHOR 442 443Copyright (c) Jochen Stenzel (perl@jochen-stenzel.de), 1999-2004. 444All rights reserved. 445 446This module is free software, you can redistribute it and/or modify it 447under the terms of the Artistic License distributed with Perl version 4485.003 or (at your option) any later version. Please refer to the 449Artistic License that came with your Perl distribution for more 450details. 451 452The Artistic License should have been included in your distribution of 453Perl. It resides in the file named "Artistic" at the top-level of the 454Perl source tree (where Perl was downloaded/unpacked - ask your 455system administrator if you dont know where this is). Alternatively, 456the current version of the Artistic License distributed with Perl can 457be viewed on-line on the World-Wide Web (WWW) from the following URL: 458http://www.perl.com/perl/misc/Artistic.html 459 460 461=head1 DISCLAIMER 462 463This software is distributed in the hope that it will be useful, but 464is provided "AS IS" WITHOUT WARRANTY OF ANY KIND, either expressed or 465implied, INCLUDING, without limitation, the implied warranties of 466MERCHANTABILITY and FITNESS FOR A PARTICULAR PURPOSE. 467 468The ENTIRE RISK as to the quality and performance of the software 469IS WITH YOU (the holder of the software). Should the software prove 470defective, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR 471CORRECTION. 472 473IN NO EVENT WILL ANY COPYRIGHT HOLDER OR ANY OTHER PARTY WHO MAY CREATE, 474MODIFY, OR DISTRIBUTE THE SOFTWARE BE LIABLE OR RESPONSIBLE TO YOU OR TO 475ANY OTHER ENTITY FOR ANY KIND OF DAMAGES (no matter how awful - not even 476if they arise from known or unknown flaws in the software). 477 478Please refer to the Artistic License that came with your Perl 479distribution for more details. 480 481