source: trunk/gsdl/cgi-bin/webpage_delcol.pl@ 1171

Last change on this file since 1171 was 1145, checked in by sjboddie, 24 years ago

attempting to get end-user collection building working under windows

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 3.8 KB
Line 
1#!perl -w
2
3###########################################################################
4#
5# webpage_delcol.pl --
6# A component of the Greenstone digital library software
7# from the New Zealand Digital Library Project at the
8# University of Waikato, New Zealand.
9#
10# Copyright (C) 1999 New Zealand Digital Library Project
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program; if not, write to the Free Software
24# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25#
26###########################################################################
27
28# This program is a webpage wrapper that deletes the named collection
29
30use CGI;
31use GSDLHOME;
32use Fcntl ':flock';
33
34require util;
35require webpageutil;
36
37sub parse_cgiargs
38{
39 # get arguments
40 my $cgi = new CGI;
41 my %args = ();
42
43 foreach $p ($cgi->param())
44 {
45 $args{$p} = $cgi->param($p);
46 }
47
48 return \%args;
49}
50
51
52
53sub main
54{
55 # get arguments
56 my $args = parse_cgiargs();
57
58 my $dirname = $args->{'bc1dirname'};
59 if (!defined($dirname))
60 {
61 # directory name derived from the collection name missing
62 my $mess = "Directory name derived from the collection name missing.";
63 &webpageutil::error_location($args,$mess);
64 return;
65 }
66
67 my $delete_area = $args->{'bc1deletearea'};
68
69 if ($delete_area eq "all")
70 {
71 # delete all files
72 my $col_dir = &util::filename_cat($ENV{'GSDLHOME'},"collect",$dirname);
73 &util::rm_r($col_dir);
74
75 # delete from collections.txt
76 my $collist_filename
77 = &util::filename_cat($ENV{'GSDLHOME'},"etc","collections.txt");
78 if (open(CLIN,"<$collist_filename"))
79 {
80 if (flock(CLIN,LOCK_EX))
81 {
82 my @keep_dirnames = ();
83 while (defined($line=<CLIN>))
84 {
85 chop $line;
86 push(@keep_dirnames,$line) if ($line ne $dirname);
87 }
88 close(CLIN);
89
90 if (open(CLIN,">$collist_filename"))
91 {
92 print CLIN join("\n",@keep_dirnames), "\n";
93 }
94
95 flock(CLIN,LOCK_UN);
96 close(CLIN);
97 }
98 else
99 {
100 # problem locking file
101 my $mess = "Unable to lock collection list configuration";
102 $mess .= " file: $collist_filename";
103 &webpageutil::error_location($args,$mess);
104 return;
105 }
106 }
107 else
108 {
109 # problem opening file for reading in
110
111 my $mess = "Unable to open for input the collection list";
112 $mess .= " configuration file: $collist_filename";
113 &webpageutil::error_location($args,$mess);
114 return;
115 }
116 }
117 elsif ($delete_area eq "import")
118 {
119
120 my $collectdir = &util::filename_cat($ENV{'GSDLHOME'},"collect",$dirname);
121 my $import_dir = &util::filename_cat($collectdir,"import");
122 my $archives_dir = &util::filename_cat($collectdir,"archives");
123 &util::rm_r($import_dir,$archives_dir);
124 &util::mk_dir($import_dir);
125 }
126 elsif ($delete_area eq "archives")
127 {
128 my $collectdir = &util::filename_cat($ENV{'GSDLHOME'},"collect",$dirname);
129 my $archives_dir = &util::filename_cat($collectdir,"archives");
130 &util::rm_r($archives_dir);
131 }
132 else
133 {
134 # unrecoginised area to delete
135 my $mess = "Unrecognised area to delete: $delete_area";
136 &webpageutil::error_location($args,$mess);
137 return;
138 }
139
140 my $mess_url = "$args->{'httpbuild'}&bca=mess";
141 $mess_url .= "&bc1dirname=$dirname" if ($delete_area ne "all");
142 print "Location: $mess_url&head=_headdone_&mess=_messdonedelcol_\n\n";
143 return;
144
145}
146
147&main();
148
149
Note: See TracBrowser for help on using the repository browser.