source: trunk/gsdl/perllib/doc.pm@ 2810

Last change on this file since 2810 was 2810, checked in by sjboddie, 20 years ago

Created GAPlug (and XMLPlug base class) to replace the old GMLPlug.
Greenstone archives will now be stored as proper XML documents (with .xml
file extension) instead of the old .gml files.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 22.3 KB
Line 
1###########################################################################
2#
3# doc.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26# base class to hold documents
27
28package doc;
29
30BEGIN {
31 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
32 unshift (@INC, "$ENV{'GSDLHOME'}/perllib/dynamic/lib/site_perl/5.005/i686-linux");
33}
34
35use unicode;
36use util;
37use ghtml;
38##use hashdoc;
39
40# the document type may be indexed_doc, nonindexed_doc, or
41# classification
42
43my $OIDcount = 0;
44
45sub new {
46 my $class = shift (@_);
47 my ($source_filename, $doc_type) = @_;
48
49 my $self = bless {'associated_files'=>[],
50 'subsection_order'=>[],
51 'next_subsection'=>1,
52 'subsections'=>{},
53 'metadata'=>[],
54 'text'=>"",
55 'OIDtype'=>"hash"}, $class;
56
57 $self->set_source_filename ($source_filename) if defined $source_filename;
58 $self->set_doc_type ($doc_type) if defined $doc_type;
59
60 return $self;
61}
62
63# clone the $self object
64sub duplicate {
65 my $self = shift (@_);
66
67 my $newobj = {};
68
69 foreach $k (keys %$self) {
70 $newobj->{$k} = &clone ($self->{$k});
71 }
72
73 bless $newobj, ref($self);
74 return $newobj;
75}
76
77sub clone {
78 my ($from) = @_;
79 my $type = ref ($from);
80
81 if ($type eq "HASH") {
82 my $to = {};
83 foreach $key (keys %$from) {
84 $to->{$key} = &clone ($from->{$key});
85 }
86 return $to;
87 } elsif ($type eq "ARRAY") {
88 my $to = [];
89 foreach $v (@$from) {
90 push (@$to, &clone ($v));
91 }
92 return $to;
93 } else {
94 return $from;
95 }
96}
97
98sub set_OIDtype {
99 my $self = shift (@_);
100 my ($type) = @_;
101
102 if ($type eq "incremental") {
103 $self->{'OIDtype'} = $type;
104 } else {
105 $self->{'OIDtype'} = "hash";
106 }
107}
108
109sub set_source_filename {
110 my $self = shift (@_);
111 my ($source_filename) = @_;
112
113 $self->set_metadata_element ($self->get_top_section(),
114 "gsdlsourcefilename",
115 $source_filename);
116}
117
118# returns the source_filename as it was provided
119sub get_source_filename {
120 my $self = shift (@_);
121
122 return $self->get_metadata_element ($self->get_top_section(), "gsdlsourcefilename");
123}
124
125sub set_doc_type {
126 my $self = shift (@_);
127 my ($doc_type) = @_;
128
129 $self->set_metadata_element ($self->get_top_section(),
130 "gsdldoctype",
131 $doc_type);
132}
133
134# returns the source_filename as it was provided
135# the default of "indexed_doc" is used if no document
136# type was provided
137sub get_doc_type {
138 my $self = shift (@_);
139
140 my $doc_type = $self->get_metadata_element ($self->get_top_section(), "gsdldoctype");
141 return $doc_type if (defined $doc_type);
142 return "indexed_doc";
143}
144
145sub _escape_text {
146 my ($text) = @_;
147
148 # special characters in the gml encoding
149 $text =~ s/&/&/g; # this has to be first...
150 $text =~ s/</&lt;/g;
151 $text =~ s/>/&gt;/g;
152 $text =~ s/\"/&quot;/g;
153
154 return $text;
155}
156
157sub buffer_section_xml {
158 my $self = shift (@_);
159 my ($section) = @_;
160
161 my $section_ptr = $self->_lookup_section ($section);
162 return "" unless defined $section_ptr;
163
164 my $all_text = "<Section>\n";
165 $all_text .= " <Description>\n";
166
167 # output metadata
168 foreach my $data (@{$section_ptr->{'metadata'}}) {
169 my $escaped_value = &_escape_text($data->[1]);
170 $all_text .= ' <Metadata name="' . $data->[0] . '">' . $escaped_value . "</Metadata>\n";
171 }
172
173 $all_text .= " </Description>\n";
174
175 # output the text
176 $all_text .= " <Content>\n";
177 $all_text .= &_escape_text($section_ptr->{'text'});
178 $all_text .= " </Content>\n";
179
180 # output all the subsections
181 foreach my $subsection (@{$section_ptr->{'subsection_order'}}) {
182 $all_text .= $self->buffer_section_xml("$section.$subsection");
183 }
184
185 $all_text .= "</Section>\n";
186
187 return $all_text;
188}
189
190sub output_section {
191 my $self = shift (@_);
192 my ($handle, $section) = @_;
193
194 print $handle $self->buffer_section_xml($section);
195}
196
197# look up the reference to the a particular section
198sub _lookup_section {
199 my $self = shift (@_);
200 my ($section) = @_;
201
202 my ($num);
203 my $sectionref = $self;
204
205 while (defined $section && $section ne "") {
206 ($num, $section) = $section =~ /^\.?(\d+)(.*)$/;
207 $num =~ s/^0+(\d)/$1/; # remove leading 0s
208 $section = "" unless defined $section;
209
210 if (defined $num && defined $sectionref->{'subsections'}->{$num}) {
211 $sectionref = $sectionref->{'subsections'}->{$num};
212 } else {
213 return undef;
214 }
215 }
216
217 return $sectionref;
218}
219
220# calculate OID by hashing the contents of the document
221sub _calc_OID {
222 my $self = shift (@_);
223 my ($filename) = @_;
224
225 my $osexe = &util::get_os_exe();
226
227 my $hashfile_exe = &util::filename_cat($ENV{'GSDLHOME'},"bin",
228 $ENV{'GSDLOS'},"hashfile$osexe");
229 my $result = "NULL";
230
231 if (-e "$hashfile_exe") {
232# $result = `\"$hashfile_exe\" \"$filename\"`;
233 $result = `hashfile$osexe \"$filename\"`;
234 ($result) = $result =~ /:\s*([0-9a-f]+)/i;
235
236 } else {
237 print STDERR "doc::_calc_OID $hashfile_exe could not be found\n";
238 }
239
240 return "HASH$result";
241}
242
243# methods dealing with OID, not groups of them.
244
245# if $OID is not provided one is calculated
246sub set_OID {
247 my $self = shift (@_);
248 my ($OID) = @_;
249
250 # if an OID wasn't provided claculate one
251 if (!defined $OID) {
252 $OID = "NULL";
253
254 if ($self->{'OIDtype'} eq "incremental") {
255 $OID = "D" . $OIDcount;
256 $OIDcount ++;
257
258 } else {
259 # "hash" OID - feed file to hashfile.exe
260 my $filename = $self->get_source_filename();
261 if (defined($filename) && -e $filename) {
262
263 $OID = $self->_calc_OID ($filename);
264
265 } else {
266 $filename = &util::get_tmp_filename();
267 if (!open (OUTFILE, ">$filename")) {
268 print STDERR "doc::set_OID could not write to $filename\n";
269 } else {
270 $self->output_section('OUTFILE', $self->get_top_section(),
271 undef, 1);
272 close (OUTFILE);
273 }
274
275 $OID = $self->_calc_OID ($filename);
276 &util::rm ($filename);
277 }
278 }
279 }
280 $self->set_metadata_element ($self->get_top_section(), "Identifier", $OID);
281}
282
283# this uses hashdoc (embedded c thingy) which is faster but still
284# needs a little work to be suffiently stable
285sub ___set_OID {
286 my $self = shift (@_);
287 my ($OID) = @_;
288
289 # if an OID wasn't provided then calculate hash value based on document
290 if (!defined $OID)
291 {
292 my $hash_text = $self->buffer_section_gml($self->get_top_section(),
293 undef, 1);
294 my $hash_len = length($hash_text);
295
296 $OID = &hashdoc::buffer($hash_text,$hash_len);
297 }
298
299 $self->set_metadata_element ($self->get_top_section(), "Identifier", $OID);
300}
301
302# returns the OID for this document
303sub get_OID {
304 my $self = shift (@_);
305 my $OID = $self->get_metadata_element ($self->get_top_section(), "Identifier");
306 return $OID if (defined $OID);
307 return "NULL";
308}
309
310sub delete_OID {
311 my $self = shift (@_);
312
313 $self->set_metadata_element ($self->get_top_section(), "Identifier", "NULL");
314}
315
316
317# methods for manipulating section names
318
319# returns the name of the top-most section (the top
320# level of the document
321sub get_top_section {
322 my $self = shift (@_);
323
324 return "";
325}
326
327# returns a section
328sub get_parent_section {
329 my $self = shift (@_);
330 my ($section) = @_;
331
332 $section =~ s/(^|\.)\d+$//;
333
334 return $section;
335}
336
337# returns the first child section (or the end child
338# if there isn't any)
339sub get_begin_child {
340 my $self = shift (@_);
341 my ($section) = @_;
342
343 my $section_ptr = $self->_lookup_section($section);
344 return "" unless defined $section_ptr;
345
346 if (defined $section_ptr->{'subsection_order'}->[0]) {
347 return "$section.$section_ptr->{'subsection_order'}->[0]";
348 }
349
350 return $self->get_end_child ($section);
351}
352
353# returns the next child of a parent section
354sub get_next_child {
355 my $self = shift (@_);
356 my ($section) = @_;
357
358 my $parent_section = $self->get_parent_section($section);
359 my $parent_section_ptr = $self->_lookup_section($parent_section);
360 return undef unless defined $parent_section_ptr;
361
362 my ($section_num) = $section =~ /(\d+)$/;
363 return undef unless defined $section_num;
364
365 my $i = 0;
366 my $section_order = $parent_section_ptr->{'subsection_order'};
367 while ($i < scalar(@$section_order)) {
368 last if $section_order->[$i] eq $section_num;
369 $i++;
370 }
371
372 $i++; # the next child
373 if ($i < scalar(@$section_order)) {
374 return $section_order->[$i] if $parent_section eq "";
375 return "$parent_section.$section_order->[$i]";
376 }
377
378 # no more sections in this level
379 return undef;
380}
381
382# returns a reference to a list of children
383sub get_children {
384 my $self = shift (@_);
385 my ($section) = @_;
386
387 my $section_ptr = $self->_lookup_section($section);
388 return [] unless defined $section_ptr;
389
390 my @children = @{$section_ptr->{'subsection_order'}};
391
392 map {$_ = "$section.$_"; $_ =~ s/^\.+//;} @children;
393 return \@children;
394}
395
396# returns the child section one past the last one (which
397# is coded as "0")
398sub get_end_child {
399 my $self = shift (@_);
400 my ($section) = @_;
401
402 return $section . ".0" unless $section eq "";
403 return "0";
404}
405
406# returns the next section in book order
407sub get_next_section {
408 my $self = shift (@_);
409 my ($section) = @_;
410
411 return undef unless defined $section;
412
413 my $section_ptr = $self->_lookup_section($section);
414 return undef unless defined $section_ptr;
415
416 # first try to find first child
417 if (defined $section_ptr->{'subsection_order'}->[0]) {
418 return $section_ptr->{'subsection_order'}->[0] if ($section eq "");
419 return "$section.$section_ptr->{'subsection_order'}->[0]";
420 }
421
422 do {
423 # try to find sibling
424 my $next_child = $self->get_next_child ($section);
425 return $next_child if (defined $next_child);
426
427 # move up one level
428 $section = $self->get_parent_section ($section);
429 } while $section =~ /\d/;
430
431 return undef;
432}
433
434sub is_leaf_section {
435 my $self = shift (@_);
436 my ($section) = @_;
437
438 my $section_ptr = $self->_lookup_section($section);
439 return 1 unless defined $section_ptr;
440
441 return (scalar (@{$section_ptr->{'subsection_order'}}) == 0);
442}
443
444# methods for dealing with sections
445
446# returns the name of the inserted section
447sub insert_section {
448 my $self = shift (@_);
449 my ($before_section) = @_;
450
451 # get the child to insert before and its parent section
452 my $parent_section = "";
453 my $before_child = "0";
454 my @before_section = split (/\./, $before_section);
455 if (scalar(@before_section) > 0) {
456 $before_child = pop (@before_section);
457 $parent_section = join (".", @before_section);
458 }
459
460 my $parent_section_ptr = $self->_lookup_section($parent_section);
461 if (!defined $parent_section_ptr) {
462 print STDERR "doc::insert_section couldn't find parent section " .
463 "$parent_section\n";
464 return;
465 }
466
467 # get the next section number
468 my $section_num = $parent_section_ptr->{'next_subsection'}++;
469
470 my $i = 0;
471 while ($i < scalar(@{$parent_section_ptr->{'subsection_order'}}) &&
472 $parent_section_ptr->{'subsection_order'}->[$i] ne $before_child) {
473 $i++;
474 }
475
476 # insert the section number into the order list
477 splice (@{$parent_section_ptr->{'subsection_order'}}, $i, 0, $section_num);
478
479 # add this section to the parent section
480 my $section_ptr = {'subsection_order'=>[],
481 'next_subsection'=>1,
482 'subsections'=>{},
483 'metadata'=>[],
484 'text'=>""};
485 $parent_section_ptr->{'subsections'}->{$section_num} = $section_ptr;
486
487 # work out the full section number
488 my $section = $parent_section;
489 $section .= "." unless $section eq "";
490 $section .= $section_num;
491
492 return $section;
493}
494
495# creates a pre-named section
496sub create_named_section {
497 my $self = shift (@_);
498 my ($mastersection) = @_;
499
500 my ($num);
501 my $section = $mastersection;
502 my $sectionref = $self;
503
504 while ($section ne "") {
505 ($num, $section) = $section =~ /^\.?(\d+)(.*)$/;
506 $num =~ s/^0+(\d)/$1/; # remove leading 0s
507 $section = "" unless defined $section;
508
509 if (defined $num) {
510 if (!defined $sectionref->{'subsections'}->{$num}) {
511 push (@{$sectionref->{'subsection_order'}}, $num);
512 $sectionref->{'subsections'}->{$num} = {'subsection_order'=>[],
513 'next_subsection'=>1,
514 'subsections'=>{},
515 'metadata'=>[],
516 'text'=>""};
517 if ($num >= $sectionref->{'next_subsection'}) {
518 $sectionref->{'next_subsection'} = $num + 1;
519 }
520 }
521 $sectionref = $sectionref->{'subsections'}->{$num};
522
523 } else {
524 print STDERR "doc::create_named_section couldn't create section ";
525 print STDERR "$mastersection\n";
526 last;
527 }
528 }
529}
530
531# returns a reference to a list of subsections
532sub list_subsections {
533 my $self = shift (@_);
534 my ($section) = @_;
535
536 my $section_ptr = $self->_lookup_section ($section);
537 if (!defined $section_ptr) {
538 print STDERR "doc::list_subsections couldn't find section $section\n";
539 return [];
540 }
541
542 return [@{$section_ptr->{'subsection_order'}}];
543}
544
545sub delete_section {
546 my $self = shift (@_);
547 my ($section) = @_;
548
549# my $section_ptr = {'subsection_order'=>[],
550# 'next_subsection'=>1,
551# 'subsections'=>{},
552# 'metadata'=>[],
553# 'text'=>""};
554
555 # if this is the top section reset everything
556 if ($section eq "") {
557 $self->{'subsection_order'} = [];
558 $self->{'subsections'} = {};
559 $self->{'metadata'} = [];
560 $self->{'text'} = "";
561 return;
562 }
563
564 # find the parent of the section to delete
565 my $parent_section = "";
566 my $child = "0";
567 my @section = split (/\./, $section);
568 if (scalar(@section) > 0) {
569 $child = pop (@section);
570 $parent_section = join (".", @section);
571 }
572
573 my $parent_section_ptr = $self->_lookup_section($parent_section);
574 if (!defined $parent_section_ptr) {
575 print STDERR "doc::delete_section couldn't find parent section " .
576 "$parent_section\n";
577 return;
578 }
579
580 # remove this section from the subsection_order list
581 my $i = 0;
582 while ($i < scalar (@{$parent_section_ptr->{'subsection_order'}})) {
583 if ($parent_section_ptr->{'subsection_order'}->[$i] eq $child) {
584 splice (@{$parent_section_ptr->{'subsection_order'}}, $i, 1);
585 last;
586 }
587 $i++;
588 }
589
590 # remove this section from the subsection hash
591 if (defined ($parent_section_ptr->{'subsections'}->{$child})) {
592 undef $parent_section_ptr->{'subsections'}->{$child};
593 }
594}
595
596#--
597# methods for dealing with metadata
598
599# set_metadata_element and get_metadata_element are for metadata
600# which should only have one value. add_meta_data and get_metadata
601# are for metadata which can have more than one value.
602
603# returns the first metadata value which matches field
604sub get_metadata_element {
605 my $self = shift (@_);
606 my ($section, $field) = @_;
607 my ($data);
608
609 my $section_ptr = $self->_lookup_section($section);
610 if (!defined $section_ptr) {
611 print STDERR "doc::get_metadata_element couldn't find section " .
612 "$section\n";
613 return;
614 }
615
616 foreach $data (@{$section_ptr->{'metadata'}}) {
617 return $data->[1] if (scalar(@$data) >= 2 && $data->[0] eq $field);
618 }
619
620 return undef; # was not found
621}
622
623
624# returns a list of the form [value1, value2, ...]
625sub get_metadata {
626 my $self = shift (@_);
627 my ($section, $field) = @_;
628 my ($data);
629
630 my $section_ptr = $self->_lookup_section($section);
631 if (!defined $section_ptr) {
632 print STDERR "doc::get_metadata couldn't find section " .
633 "$section\n";
634 return;
635 }
636
637 my @metadata = ();
638 foreach $data (@{$section_ptr->{'metadata'}}) {
639 push (@metadata, $data->[1]) if ($data->[0] eq $field);
640 }
641
642 return \@metadata;
643}
644
645# returns a list of the form [[field,value],[field,value],...]
646sub get_all_metadata {
647 my $self = shift (@_);
648 my ($section) = @_;
649
650 my $section_ptr = $self->_lookup_section($section);
651 if (!defined $section_ptr) {
652 print STDERR "doc::get_all_metadata couldn't find section " .
653 "$section\n";
654 return;
655 }
656
657 return $section_ptr->{'metadata'};
658}
659
660# $value is optional
661sub delete_metadata {
662 my $self = shift (@_);
663 my ($section, $field, $value) = @_;
664
665 my $section_ptr = $self->_lookup_section($section);
666 if (!defined $section_ptr) {
667 print STDERR "doc::delete_metadata couldn't find section " .
668 "$section\n";
669 return;
670 }
671
672 my $i = 0;
673 while ($i < scalar (@{$section_ptr->{'metadata'}})) {
674 if (($section_ptr->{'metadata'}->[$i]->[0] eq $field) &&
675 (!defined $value || $section_ptr->{'metadata'}->[$i]->[1] eq $value)) {
676 splice (@{$section_ptr->{'metadata'}}, $i, 1);
677 } else {
678 $i++;
679 }
680 }
681}
682
683sub delete_all_metadata {
684 my $self = shift (@_);
685 my ($section) = @_;
686
687 my $section_ptr = $self->_lookup_section($section);
688 if (!defined $section_ptr) {
689 print STDERR "doc::delete_all_metadata couldn't find section " .
690 "$section\n";
691 return;
692 }
693
694 $section_ptr->{'metadata'} = [];
695}
696
697sub set_metadata_element {
698 my $self = shift (@_);
699 my ($section, $field, $value) = @_;
700
701 $self->set_utf8_metadata_element ($section, $field,
702 &unicode::ascii2utf8(\$value));
703}
704
705# set_utf8_metadata_element assumes the text has already been
706# converted to the UTF-8 encoding.
707sub set_utf8_metadata_element {
708 my $self = shift (@_);
709 my ($section, $field, $value) = @_;
710
711 $self->delete_metadata ($section, $field);
712 $self->add_utf8_metadata ($section, $field, $value);
713}
714
715
716# add_metadata assumes the text is in (extended) ascii form. For
717# text which hash been already converted to the UTF-8 format use
718# add_utf8_metadata.
719sub add_metadata {
720 my $self = shift (@_);
721 my ($section, $field, $value) = @_;
722
723 $self->add_utf8_metadata ($section, $field,
724 &unicode::ascii2utf8(\$value));
725}
726
727# add_utf8_metadata assumes the text has already been converted
728# to the UTF-8 encoding.
729sub add_utf8_metadata {
730 my $self = shift (@_);
731 my ($section, $field, $value) = @_;
732
733 my $section_ptr = $self->_lookup_section($section);
734 if (!defined $section_ptr) {
735 print STDERR "doc::add_utf8_metadata couldn't find section " .
736 "$section\n";
737 return;
738 }
739 if (!defined $value) {
740 print STDERR "doc::add_utf8_metadata undefined value for $field\n";
741 return;
742 }
743 if (!defined $field) {
744 print STDERR "doc::add_utf8_metadata undefined metadata type \n";
745 return;
746 }
747
748 push (@{$section_ptr->{'metadata'}}, [$field, $value]);
749}
750
751
752# methods for dealing with text
753
754# returns the text for a section
755sub get_text {
756 my $self = shift (@_);
757 my ($section) = @_;
758
759 my $section_ptr = $self->_lookup_section($section);
760 if (!defined $section_ptr) {
761 print STDERR "doc::get_text couldn't find section " .
762 "$section\n";
763 return "";
764 }
765
766 return $section_ptr->{'text'};
767}
768
769# returns the (utf-8 encoded) length of the text for a section
770sub get_text_length {
771 my $self = shift (@_);
772 my ($section) = @_;
773
774 my $section_ptr = $self->_lookup_section($section);
775 if (!defined $section_ptr) {
776 print STDERR "doc::get_text_length couldn't find section " .
777 "$section\n";
778 return 0;
779 }
780
781 return length ($section_ptr->{'text'});
782}
783
784sub delete_text {
785 my $self = shift (@_);
786 my ($section) = @_;
787
788 my $section_ptr = $self->_lookup_section($section);
789 if (!defined $section_ptr) {
790 print STDERR "doc::delete_text couldn't find section " .
791 "$section\n";
792 return;
793 }
794
795 $section_ptr->{'text'} = "";
796}
797
798# add_text assumes the text is in (extended) ascii form. For
799# text which has been already converted to the UTF-8 format
800# use add_utf8_text.
801sub add_text {
802 my $self = shift (@_);
803 my ($section, $text) = @_;
804
805 # convert the text to UTF-8 encoded unicode characters
806 # and add the text
807 $self->add_utf8_text($section, &unicode::ascii2utf8(\$text));
808}
809
810
811# add_utf8_text assumes the text to be added has already
812# been converted to the UTF-8 encoding. For ascii text use
813# add_text
814sub add_utf8_text {
815 my $self = shift (@_);
816 my ($section, $text) = @_;
817
818 my $section_ptr = $self->_lookup_section($section);
819 if (!defined $section_ptr) {
820 print STDERR "doc::add_utf8_text couldn't find section " .
821 "$section\n";
822 return;
823 }
824
825 $section_ptr->{'text'} .= $text;
826}
827
828
829# methods for dealing with associated files
830
831# a file is associated with a document, NOT a section.
832# if section is defined it is noted in the data structure
833# only so that files associated from a particular section
834# may be removed later (using delete_section_assoc_files)
835sub associate_file {
836 my $self = shift (@_);
837 my ($real_filename, $assoc_filename, $mime_type, $section) = @_;
838 $mime_type = &ghtml::guess_mime_type ($real_filename) unless defined $mime_type;
839
840 # remove all associated files with the same name
841 $self->delete_assoc_file ($assoc_filename);
842
843 push (@{$self->{'associated_files'}},
844 [$real_filename, $assoc_filename, $mime_type, $section]);
845}
846
847# returns a list of associated files in the form
848# [[real_filename, assoc_filename, mimetype], ...]
849sub get_assoc_files {
850 my $self = shift (@_);
851
852 return $self->{'associated_files'};
853}
854
855sub delete_section_assoc_files {
856 my $self = shift (@_);
857 my ($section) = @_;
858
859 my $i=0;
860 while ($i < scalar (@{$self->{'associated_files'}})) {
861 if (defined $self->{'associated_files'}->[$i]->[3] &&
862 $self->{'associated_files'}->[$i]->[3] eq $section) {
863 splice (@{$self->{'associated_files'}}, $i, 1);
864 } else {
865 $i++;
866 }
867 }
868}
869
870sub delete_assoc_file {
871 my $self = shift (@_);
872 my ($assoc_filename) = @_;
873
874 my $i=0;
875 while ($i < scalar (@{$self->{'associated_files'}})) {
876 if ($self->{'associated_files'}->[$i]->[1] eq $assoc_filename) {
877 splice (@{$self->{'associated_files'}}, $i, 1);
878 } else {
879 $i++;
880 }
881 }
882}
883
884sub reset_nextsection_ptr {
885 my $self = shift (@_);
886 my ($section) = @_;
887
888 my $section_ptr = $self->_lookup_section($section);
889 $section_ptr->{'next_subsection'} = 1;
890}
891
8921;
Note: See TracBrowser for help on using the repository browser.