#!perl -w ########################################################################### # # webpage_editcol.pl -- # A component of the Greenstone digital library software # from the New Zealand Digital Library Project at the # University of Waikato, New Zealand. # # Copyright (C) 1999 New Zealand Digital Library Project # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. # ########################################################################### # This program is a webpage wrapper for saving an edited config file package webpage_editcol; use CGI; use GSDLHOME; use gflock; require util; require webpageutil; sub parse_cgiargs { # get arguments my $cgi = new CGI; my %args = (); foreach $p ($cgi->param()) { $args{$p} = $cgi->param($p); } return \%args; } sub main { # get arguments my $args = parse_cgiargs(); my $dirname = $args->{'bc1dirname'}; if (!defined($dirname)) { # directory name derived from the collection name missing my $mess = "Directory name for collection missing."; &webpageutil::error_location($args,$mess); return; } my $cfg_filename = &util::filename_cat($ENV{'GSDLHOME'},"collect",$dirname,"etc","collect.cfg"); if (open(CFGOUT,">$cfg_filename")) { binmode (CFGOUT); # windows if (&gflock::lock (webpage_editcol::CFGOUT)) { my $cfg_text = $args->{'bc1cfgfile'}; print CFGOUT "$cfg_text"; &gflock::unlock (webpage_editcol::CFGOUT); close(CFGOUT); } else { # problem locking file my $mess = "Unable to lock configuration file: $cfg_filename"; &webpageutil::error_location($args,$mess); return; } } else { # unable to open configuration file for writing my $mess = "Unable to open for writing configuration file: $cfg_filename"; &webpageutil::error_location($args,$mess); return; } my $mess_url = "$args->{'httpbuild'}&bca=mess&bc1dirname=$dirname"; print "Location: $mess_url&head=_headdone_&mess=_messdoneeditcol_\n\n"; return; } &main();