source: trunk/gsdl/perllib/classify/Collage.pm@ 6983

Last change on this file since 6983 was 6968, checked in by kjdon, 20 years ago

all classifiers now use BasClas.buttonname for their buttonname option description.
removed the old print_usage methods and old usage notes.
added in a test for $self->{'info_only'} in new(): if this is set, don't try and parse the arguments cos we are only running classinfo.pl.

  • Property svn:keywords set to Author Date Id Revision
File size: 3.3 KB
Line 
1###########################################################################
2#
3# Collage.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
26package Collage;
27
28use BasClas;
29use sorttools;
30
31sub BEGIN {
32 @ISA = ('BasClas');
33}
34
35my $arguments =
36 [ { 'name' => "buttonname",
37 'desc' => "{BasClas.buttonname}",
38 'type' => "string",
39 'deft' => "Collage",
40 'reqd' => "no" }];
41
42my $options = { 'name' => "Collage",
43 'desc' => "{Collage.desc}",
44 'inherits' => "Yes",
45 'args' => $arguments };
46
47
48sub new {
49 my $class = shift (@_);
50 my $self = new BasClas($class, @_);
51
52 my $option_list = $self->{'option_list'};
53 push( @{$option_list}, $options );
54
55 if ($self->{'info_only'}) {
56 # created from classinfo.pl - don't need to parse the arguments
57 return bless $self, $class;
58 }
59
60 my ($title, $list);
61
62 if (!parsargv::parse(\@_,
63 q^buttonname/.*/^, \$title,
64 "allow_extra_options")) {
65
66 print STDERR "\nIncorrect options passed to $class, check your collect.cfg file\n";
67 $self->print_txt_usage(""); # Use default resource bundle
68 die "\n";
69 }
70
71 if (!$title) {
72 $title = 'Collage';
73 }
74
75 $self->{'collection'} = $ENV{'GSDLCOLLECTION'};
76 $self->{'list'} = $list;
77 $self->{'title'} = $title;
78
79 return bless $self, $class;
80}
81
82sub init {
83 my $self = shift (@_);
84
85 $self->{'list'} = [];
86}
87
88sub classify {
89
90 my $self = shift (@_);
91 my ($doc_obj) = @_;
92
93 my $doc_OID = $doc_obj->get_OID();
94 push (@{$self->{'list'}}, $doc_OID);
95
96 foreach $assoc_file (@{$doc_obj->get_assoc_files()}) {
97 push (@{$self->{'imagelist'}}, $assoc_file->[1]);
98 }
99
100}
101
102sub get_classify_info {
103 my $self = shift (@_);
104
105 my @imagelist = ();
106 @imagelist = @{$self->{'imagelist'}};
107
108 my @list = ();
109 @list = @{$self->{'list'}};
110
111 print STDOUT ("$self->{'title'}\n");
112
113 my $classifyinfo = $self->get_entry ($self->{'title'}, "Collage", "Invisible");
114
115 my %collage = ();
116
117 foreach $oid (@list) {
118 push (@{$collage->{'contains'}}, {'OID'=>$oid});
119 }
120
121 push (@{$classifyinfo->{'contains'}}, $collage);
122
123 return $classifyinfo;
124}
125
126
127sub get_entry {
128 my $self = shift (@_);
129 my ($title, $childtype, $thistype) = @_;
130
131
132 # organise into classification structure
133 my %classifyinfo = ('thistype'=>$thistype,
134 'childtype'=>$childtype,
135 'Title'=>$title,
136 'contains'=>[]);
137
138 return \%classifyinfo;
139}
140
1411;
Note: See TracBrowser for help on using the repository browser.