package Alexandria::Docman;
#
# Copyright (C) 2002-2004 Open Source Development Network, Inc. ("OSDN")
# Copyright (C) 2004 OSTG, Inc. ("OSTG")
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the license details found
# below in the section marked "$LICENSE_TEXT".
#
# $Id: Docman.pm,v 1.2 2005/03/01 11:51:49 moorman Exp $
#
# Written by Jacob Moorman <moorman@sourceforge.net>
###########################################################################
# Use all strictness, list intended global variables
use strict;
use Alexandria::Client;
use HTTP::Request::Common;
use vars qw($THIS); #global self-reference of last docman initialized
$LICENSE_TEXT = '
Copyright (c) 2002-2004 Open Source Development Network, Inc. ("OSDN")
Copyright (c) 2004 OSTG, Inc. ("OSTG")
Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, sublicense,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:
1. The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.
2. Neither the names of VA Software Corporation, OSDN, OSTG, SourceForge.net,
the SourceForge.net Site Documentation project, nor the names of its
contributors may be used to endorse or promote products derived from
the Software without specific prior written permission of OSTG.
3. The name and trademarks of copyright holders may NOT be used in
advertising or publicity pertaining to the Software without specific,
written prior permission. Title to copyright in the Software and
any associated documentation will at all times remain with copyright
holders.
4. If any files are modified, you must cause the modified files to carry
prominent notices stating that you changed the files and the date of
any change. We recommend that you provide URLs to the location from which
the code is derived.
5. Altered versions of the Software must be plainly marked as such, and
must not be misrepresented as being the original Software.
6. The origin of the Software must not be misrepresented; you must not
claim that you wrote the original Software. If you use the Software in a
product, an acknowledgment in the product documentation would be
appreciated but is not required.
7. The data files supplied as input to, or produced as output from,
the programs of the Software do not automatically fall under the
copyright of the Software, but belong to whomever generated them, and may
be sold commercially, and may be aggregated with the Software.
8. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE OR DOCUMENTATION.
This Software consists of contributions made by OSTG and many individuals
on behalf of OSTG. Specific attributions are listed in the accompanying
credits file.
';
sub BEGIN
{
use Exporter ();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA=qw(Exporter);
@EXPORT=qw(
sfnet_docman_createnew
sfnet_docman_docgroup
sfnet_docman_docgroup_create
sfnet_docman_docgroup_delete
sfnet_docman_docgroup_rename
sfnet_docman_download
sfnet_docman_download_retrievedata
sfnet_docman_list_documents
sfnet_docman_list_documentsbystate
sfnet_docman_list_docgroups
sfnet_docman_list_languages
sfnet_docman_modify
);
}
sub sfnet_docman_createnew { $THIS->createnew(@_) }
sub sfnet_docman_docgroup { $THIS->docgroup(@_) }
sub sfnet_docman_docgroup_create { $THIS->docgroup_create(@_) }
sub sfnet_docman_docgroup_delete { $THIS->docgroup_delete(@_) }
sub sfnet_docman_docgroup_rename { $THIS->docgroup_rename(@_) }
sub sfnet_docman_download { $THIS->download(@_) }
sub sfnet_docman_download_retrievedata { $THIS->download_retrievedata(@_) }
sub sfnet_docman_list_documents { $THIS->list_documents(@_) }
sub sfnet_docman_list_documentsbystate { $THIS->list_documentsbystate(@_) }
sub sfnet_docman_list_docgroups { $THIS->list_docgroups(@_) }
sub sfnet_docman_list_languagees { $THIS->list_languages(@_) }
sub sfnet_docman_modify { $THIS->modify(@_) }
###########################################################################
#
# Sub new
#
# creates a new Alexandria Docman object
#
# Parameters
# $CLIENT - the Alexandria::Client object you have sucessfully connected to
# group_id - the group_id you are initializing a docman object for
#
sub new {
my ($CLIENT, $group_id) = @_;
my $this = {};
bless $this;
die "cannot create a docman object without a valid Alexandria Client and group_id"
unless $CLIENT and $group_id;
$this->{client} = $CLIENT;
$this->{group_id} = $group_id;
$THIS=$this; #set the global self-reference
return $this;
}
# Create a new DocManager document
sub createnew {
my ($this) = @_;
util_output("verbose", "Creating a new DocManager document.");
# Intialize the PRNG, generate a random string to use for
# identification of new document, since DocManager doesn't tell
# us the docid of new documents
srand;
my $randomstring;
my $i;
for ($i = 1; $i < 4; $i++) {
$randomstring .= rand(32000);
}
# Obtain the current time/date stamp
my $date = util_currenttime("");
# Retrieve a list of languages and docgroups, select one of each
# randomly, since this will be changed later (it has no real impact
# right now, anyway)
my %languagechoices = $this->list_languages();
my %docgroupchoices = $this->list_docgroups("");
my $language = ((keys %languagechoices)
[int rand keys %languagechoices]);
my $docgroup = ((keys %docgroupchoices)
[int rand keys %docgroupchoices]);
# Build default document
my %document = ();
$document{title} = 'adocman-created document: '. $randomstring;
$document{summary} = 'created on: '. $date;
$document{body} = 'Document created by adocman '. $VERSION.
' on '. $date. '.';
$document{language} = $language;
$document{docgroup} = $docgroup;
# Perform creation of document
my $res = request
(POST
$config{hosturl}. "/docman/new.php",
content => [ 'mode' => 'add',
'group_id' => $config{groupid},
'title' => $document{title},
'description' => $document{summary},
'data' => $document{body},
'language_id' => $document{language},
'doc_group' => $document{docgroup},
]
);
# Check to see if we failed to get a result from the server
if (!$res->is_success) {
util_output("verbose", "Failed to create document.");
util_output("die", "$res->as_string", "1");
}
# Check to see if our result contained the success phrase
my $submitresult = $res->content;
(my $modifiedhtml = $submitresult) =~ s/submission has been placed//;
if ($modifiedhtml ne $submitresult) {
util_output("verbose", "Completed create ".
"successfully, per result page.");
}
# Locate the docid for the new document (document will be in
# the list of documents with 'pending' status
$config{documentstate} = 3; # Set documentstate to Pending
my %urls = $this->list_documentsbystate("");
my $found_match = 0;
util_output("verbose", "-- START OF REQUESTED OUTPUT --");
my $key;
foreach $key (keys %urls) {
if ($urls{$key} eq $document{title}) {
(my $value = $key) =~ s/^(.*)(docid=)([0-9]+)(.*)/$3/;
util_output("quiet", $value);
$found_match = 1;
}
}
util_output("verbose", "--- END OF REQUESTED OUTPUT ---");
if (!$found_match) {
util_output("die", "Unable to locate new document.",
"1");
} else {
util_output("verbose", "Completed create ".
"operation successfully.");
}
util_output("verbose", "Completed document create operation.");
}
# Perform an operation to manipulate the doc groups for a specific DocManager
sub docgroup {
my ($this) = @_;
util_output("verbose", "Performing a docgroup operation.");
verifylogin("");
if ($config{docgroup} eq "delete") {
$this->docgroup_delete("");
} elsif ($config{docgroup} eq "rename") {
$this->docgroup_rename("");
} elsif ($config{docgroup} eq "create") {
$this->docgroup_create("");
} else {
util_output("die", "Invalid --docgroup mode ".
"specified: $config{docgroup}", "4");
}
util_output("verbose", "Completed docgroup operation.");
}
# Create a new docgroup, return our best guess about its doc group ID
sub docgroup_create {
my ($this) = @_;
# FIXME: Would be nice if SF.net returned the grouid for us
# so we didn't have to do this dirty lookup
util_output("verbose", "Creating a docgroup.");
util_verifyvariables("groupid", "docgroupname");
my $res = request
(POST
$config{hosturl}. "/docman/admin/index.php",
content => [ 'mode' => 'groupadd',
'group_id' => $config{groupid},
'groupname' => $config{docgroupname}
]
);
# Check to see if we failed to get a result from the server
if (!$res->is_success) {
util_output("verbose", "Failed to create docgroup.");
util_output("die", "$res->as_string", "1");
}
# Check to see if our result contained the success phrase
my $submitresult = $res->content;
(my $modifiedhtml = $submitresult) =~ s/Group(.*)added//;
if ($modifiedhtml ne $submitresult) {
util_output("verbose", "Completed create ".
"successfully, per result page.");
}
util_output("verbose", "-- START OF REQUESTED OUTPUT --");
# Do a dirty retrieve of the new doc group id
my %options = $this->list_docgroups("");
my $found_match = 0;
my $key;
foreach $key (keys %options) {
if ($options{$key} eq $config{docgroupname}) {
util_output("quiet", "$key");
$found_match = 1;
}
}
util_output("verbose", "--- END OF REQUESTED OUTPUT ---");
if (!$found_match) {
util_output("die", "Unable to locate new docgroup.",
"1");
} else {
util_output("verbose", "Completed create ".
"operation successfully.");
}
}
# Remove a docgroup by its doc group ID
sub docgroup_delete {
my ($this) = @_;
util_output("verbose", "Deleting a docgroup.");
util_verifyvariables("docgroupid", "groupid");
my $res = request
(POST
$config{hosturl}. "/docman/admin/index.php",
content => [ 'mode' => 'groupdelete',
'group_id' => $config{groupid},
'doc_group' => $config{docgroupid}
]
);
# Check to see if we failed to get a result from the server
if (!$res->is_success) {
util_output("verbose", "Failed to delete docgroup.");
util_output("die", "$res->as_string", "1");
}
# Check to see if our result contained the success phrase
my $submitresult = $res->content;
(my $modifiedhtml = $submitresult) =~ s/Group deleted//;
if ($modifiedhtml ne $submitresult) {
util_output("verbose", "Completed delete ".
"successfully, per result page.");
}
# Verify that the doc group ID is gone from the list
my %options = $this->list_docgroups("");
if (defined($options{$config{docgroupid}})) {
util_output("die", "Deletion of docgroup failed.",
"1");
} else {
util_output("verbose", "Completed delete ".
"operation successfully.");
}
}
# Rename an existing DocManager doc group
sub docgroup_rename {
my ($this) = @_;
util_output("verbose", "Renaming a docgroup.");
util_verifyvariables("docgroupid", "docgroupname", "groupid");
my $res = request
(POST
$config{hosturl}. "/docman/admin/index.php",
content => [ 'mode' => 'groupdoedit',
'group_id' => $config{groupid},
'doc_group' => $config{docgroupid},
'groupname' => $config{docgroupname},
]
);
# Check to see if we failed to get a result from the server
if (!$res->is_success) {
util_output("verbose", "Failed to rename docgroup.");
util_output("die", "$res->as_string", "1");
}
# Check to see if our result contained the success phrase
my $submitresult = $res->content;
(my $modifiedhtml = $submitresult) =~ s/Document Group Edited//;
if ($modifiedhtml ne $submitresult) {
util_output("verbose", "Completed rename ".
"successfully, per result page.");
}
# Verify that the doc group matches now matches our new value
my %options = $this->list_docgroups("");
if ($options{$config{docgroupid}} ne $config{docgroupname}) {
util_output("die", "Rename of docgroup failed.",
"1");
} else {
util_output("verbose", "Completed rename ".
"operation successfully.");
}
}
# Perform a download operation (i.e. retrieve content from the DocManager
# system and output this content to one or more files).
sub download {
my ($this) = @_;
util_output("verbose", "Performing a download operation.");
util_verifyvariables("groupid", "docid");
verifylogin("");
if (!defined($config{filename}) && !defined($config{directoryname})) {
util_output("die", "Either filename or ".
"directoryname must be specified.", "4");
}
if (defined($config{directoryname})) {
util_mkdir($config{directoryname});
}
my %document = $this->download_retrievedata("");
my $filename;
if (defined($config{directoryname}) && (!defined($config{noiddata}))) {
util_filewriter($config{directoryname}. "/docid",
$config{docid});
}
if (($config{download} eq "title") || ($config{download} eq "all")) {
if (($config{download} eq "title") &&
(defined($config{filename}))) {
$filename = $config{filename};
} else {
$filename = $config{directoryname}. "/title";
}
util_filewriter($filename, $document{title});
}
if (($config{download} eq "summary") || ($config{download} eq "all")) {
if (($config{download} eq "summary") &&
(defined($config{filename}))) {
$filename = $config{filename};
} else {
$filename = $config{directoryname}. "/summary";
}
util_filewriter($filename, $document{summary});
}
if (($config{download} eq "language") ||
($config{download} eq "all")) {
if (($config{download} eq "language") &&
(defined($config{filename}))) {
$filename = $config{filename};
} else {
$filename = $config{directoryname}. "/language";
}
util_filewriter($filename,
"$document{language_id}[0] ".
"$document{language_id}[1]");
}
if (($config{download} eq "state") || ($config{download} eq "all")) {
if (($config{download} eq "state") &&
(defined($config{filename}))) {
$filename = $config{filename};
} else {
$filename = $config{directoryname}. "/state";
}
util_filewriter($filename,
"$document{stateid}[0] ".
"$document{stateid}[1]");
}
if (($config{download} eq "docgroup") ||
($config{download} eq "all")) {
if (($config{download} eq "docgroup") &&
(defined($config{filename}))) {
$filename = $config{filename};
} else {
$filename = $config{directoryname}. "/docgroup";
}
util_filewriter($filename,
"$document{doc_group}[0] ".
"$document{doc_group}[1]");
}
if (($config{download} eq "creationdate") ||
($config{download} eq "all")) {
if (($config{download} eq "creationdate") &&
(defined($config{filename}))) {
$filename = $config{filename};
} else {
$filename = $config{directoryname}. "/creationdate";
}
util_filewriter($filename, $document{creationdate});
}
if (($config{download} eq "updatedate") ||
($config{download} eq "all")) {
if (($config{download} eq "updatedate") &&
(defined($config{filename}))) {
$filename = $config{filename};
} else {
$filename = $config{directoryname}. "/updatedate";
}
util_filewriter($filename, $document{updatedate});
}
if (($config{download} eq "body") ||
($config{download} eq "all")) {
if (($config{download} eq "body") &&
(defined($config{filename}))) {
$filename = $config{filename};
} else {
$filename = $config{directoryname}. "/body";
}
util_filewriter($filename, $document{body});
}
util_output("verbose", "Completed download operation.");
}
# Perform data retrieval operations for a document's content and properties
# from the DocManager system
sub download_retrievedata {
my ($this) = @_;
my $request = HTTP::Request->new(GET =>
$config{hosturl}. "/docman/admin/index.php".
"?group_id=". $config{groupid}. "&docid=".
$config{docid}. "&mode=docedit");
my $res = request($request);
my $html = $res->content;
my %document = ();
# Trim the content to this form, for sake of expediancy
my $formhtml = util_extractform($html, "editdata");
# Parse the document to obtain a full set of data
my $parser = HTML::TokeParser->new(\$formhtml);
my $current_select = "";
my $current_field = "";
while (my $token = $parser->get_token()) {
my $type = $token->[0];
if ($type eq "S") {
my $tag = $token->[1];
if ($tag eq "input") {
my $name = $token->[2]{name} || "-";
my $value = $token->[2]{value} || "-";
if ($name eq "title") {
$document{title} = $value;
} elsif ($name eq "description") {
$document{summary} = $value;
}
} elsif ($tag eq "select") {
my $name = $token->[2]{name} || "-";
$current_select = $name;
} elsif ($tag eq "option") {
if (defined($token->[2]{selected})) {
my $label = $parser->get_trimmed_text;
my $value = $token->[2]{value};
$document{$current_select} =
[$value, $label];
}
} elsif ($tag eq "textarea") {
my $name = $token->[2]{name} || "-";
if ($name eq "data") {
my $body = $parser->get_text;
$document{body} = $body;
}
} elsif ($tag eq "th") {
my $fieldname= $parser->get_trimmed_text;
if ($fieldname eq "Creation date:") {
$current_field = "creationdate";
} elsif ($fieldname eq "Update date:") {
$current_field = "updatedate";
}
} elsif (($tag eq "table") || ($tag eq "tr")) {
$current_field="";
} elsif ($tag eq "td") {
if ($current_field ne "") {
my $value = $parser->get_trimmed_text;
$document{$current_field} = $value;
}
}
}
}
return %document;
}
# Operation to retrieve a list of documents in a specific DocManager
sub list_documents {
my ($this) = @_;
util_output("verbose", "Obtaining list of DocManager ".
"documents.");
my $request = HTTP::Request->new(GET =>
$config{hosturl}. "/docman/index.php?group_id=".
$config{groupid});
my $res = request($request);
my $html = $res->content;
my %urls = util_extracturls($html);
# If we are not being called by our parent function (--list),
# someone is requesting our hash of URL data.
if (!defined($config{list})) {
return %urls;
}
for (keys %urls) {
if (/^display_doc/) {
(my $value = $_) =~ s/^(.*)(docid=)([0-9]+)(.*)/$3/;
if ($config{quiet}) {
util_output("quiet", $value);
} else {
util_output("normal",
"$value $urls{$_}");
}
}
}
util_output("verbose", "Completed listing of DocManager ".
"documents.");
}
# Operation to retrieve a list of the documents classified under a
# specific state
sub list_documentsbystate {
my ($this) = @_;
# FIXME: it would be nice if we could work from a real listing
# of document state information, rather than values 1-5
util_output("verbose", "Retrieving list of documents by ".
"state");
util_verifyvariables("groupid", "documentstate");
# Convert document state to numeric id, verify we have a valid
# (known) value for document state
if ($config{documentstate} =~ /^\D/) {
if ($config{documentstate} =~ /ctive/) {
# Active
$config{documentstate} = 1;
} elsif ($config{documentstate} =~ /eleted/) {
# Deleted
$config{documentstate} = 2;
} elsif ($config{documentstate} =~ /ending/) {
# Pending
$config{documentstate} = 3;
} elsif ($config{documentstate} =~ /idden/) {
# Hidden
$config{documentstate} = 4;
} elsif ($config{documentstate} =~ /rivate/) {
# Private
$config{documentstate} = 5;
} else {
util_output("die", "Invalid document state.",
"4");
}
} else {
if (($config{documentstate} < 1) ||
($config{documentstate} > 5)) {
util_output("die", "Invalid document state.",
"4");
}
}
my $targettext;
# Specify the target text for our section
if ($config{documentstate} == 1) {
$targettext = "Active Documents:";
} elsif ($config{documentstate} == 2) {
$targettext = "Deleted Documents:";
} elsif ($config{documentstate} == 3) {
$targettext = "Pending Documents:";
} elsif ($config{documentstate} == 4) {
$targettext = "Hidden Documents:";
} elsif ($config{documentstate} == 5) {
$targettext = "Private Documents:";
}
# Retrieve a full document listing
my $request = HTTP::Request->new(GET =>
$config{hosturl}. "/docman/admin/index.php?".
"group_id=". $config{groupid}. "&mode=editdocs");
my $res = request($request);
my $html = $res->content;
# Parse the retrieved document listing to extract our docs
my $found_target = 0;
my $finished_with_target = 0;
my %urls = ();
my $parser = HTML::TokeParser->new(\$html);
while ((my $token = $parser->get_token()) &&
(!$finished_with_target)) {
# Check to see if the next token is a start tag
my $type = $token->[0];
if ($type eq "S") {
my $tag = $token->[1];
if ($tag eq "b") {
# Our target will be bolded
my $text = $parser->get_trimmed_text;
if ($text eq $targettext) {
$found_target = 1;
} elsif ($text =~ /\:/) {
if ($found_target == 1) {
$finished_with_target = 1;
}
}
} elsif ($tag eq "a") {
# If we're in the target zone, collect URLs
if ($found_target == 1) {
my $url = $token->[2]{href} || "-";
my $urltext = $parser->
get_trimmed_text("/a");
$urls{$url} = $urltext;
}
}
}
}
# If we are not being called by our parent function (--list),
# someone is requesting our hash of URL data.
if (!defined($config{list})) {
return %urls;
}
util_output("verbose", "-- START OF REQUESTED OUTPUT --");
# docID URLs will match this spec:
# index.php?docid=11494&mode=docedit&group_id=32950
for (keys %urls) {
if (/^index.php\?docid/) {
(my $value = $_) =~ s/^(.*)(docid=)([0-9]+)(.*)/$3/;
if ($config{quiet}) {
util_output("quiet", $value);
} else {
util_output("normal",
"$value $urls{$_}");
}
}
}
util_output("verbose", "--- END OF REQUESTED OUTPUT ---");
util_output("verbose", "Completed listing of DocManager ".
"documents by state.");
}
# Operation to retrieve a list of the docgroups for a specific DocManager
sub list_docgroups {
my ($this) = @_;
util_output("verbose", "Obtaining list of DocManager ".
"groups.");
my $request = HTTP::Request->new(GET =>
$config{hosturl}. "/docman/new.php?group_id=".
$config{groupid});
my $res = request($request);
my $html = $res->content;
# Trim the content to this form, for sake of expediancy
my $formhtml = util_extractform($html, "adddata");
# Get and output a list of the options (and values?)
my %options = util_getselectoptions($formhtml, "doc_group");
# Delete option with identifier '100', as it is the default
# docgroup of 'None' and cannot be used in performing operations
# (i.e. the DocManager will not permit documents to be set to this
# value)
delete($options{"100"});
# Only provide output if this was called by our standard parent,
# the function for the --list option -- otherwise, someone is using
# this function simply to do the retrieve
if (defined($config{list})) {
util_outputselectoptions(\%options);
} else {
return %options;
}
util_output("verbose", "Completed listing of DocManager ".
"groups.");
}
# Operation to retrieve a list of the supported languages for a DocManager
sub list_languages {
my ($this) = @_;
util_output("verbose", "Obtaining list of DocManager ".
"languages.");
my $request = HTTP::Request->new(GET =>
$config{hosturl}. "/docman/new.php?group_id=".
$config{groupid});
my $res = request($request);
my $html = $res->content;
# Trim the content to this form, for sake of expediancy
my $formhtml = util_extractform($html, "adddata");
# Get and output a list of the options (and values?)
my %options = util_getselectoptions($formhtml, "language_id");
# Only provide output if this was called by our standard parent,
# the function for the --list option -- otherwise, someone is using
# this function simply to do the retrieve
if (defined($config{list})) {
util_outputselectoptions(\%options);
} else {
return %options;
}
util_output("verbose", "Completed listing of DocManager ".
"languages.");
}
# Modify the content for one or more fields pertaining to a document
sub modify {
my ($this) = @_;
util_output("verbose", "Modifying a DocManager document.");
util_verifyvariables("groupid", "docid");
verifylogin("");
my %document = ();
# Verify that we have a valid --modify type
my @validtypes = qw(all body docgroup language state summary title);
my $type;
my %seen = ();
foreach $type (@validtypes) { $seen{$type} = 1; }
if ($seen{$config{modify}} != 1) {
util_output("die", "Unknown --modify type: ".
$config{modify}, "4");
}
# Verify that we have a source for content
if (!defined($config{filename}) && !defined($config{directoryname})) {
util_output("die", "Either filename or ".
"directoryname must be specified.", "4");
} elsif (!defined($config{directoryname}) &&
($config{modify} eq "all")) {
util_output("die", "The directoryname must be ".
"specified when using --modify=all", "4");
}
# Read the required document content from file or directory
if (defined($config{directoryname})) {
%document = util_readdownloaddir("");
} else {
my $filepath = util_expandtildes($config{filename});
util_output("verbose", "Reading contents of ".
"$filepath");
unless (open(INPUTFILE, "$filepath")) {
util_output("die", "Unable to open file for ".
"reading: $filepath", "5");
}
# Undefine the record separator, so we can slurp the whole file
undef $/;
$document{$config{modify}} = <INPUTFILE>;
close(INPUTFILE);
}
# If we are not modifying "all", we will need to stuff the
# fields we do not wish to modify with their current values
if ($config{modify} ne "all") {
util_output("verbose", "Retrieve original field data ".
"so we can modify just one field.");
my %existingdocument = ();
%existingdocument = $this->download_retrievedata("");
# Convert from the download variable names to the names
# we expect here, to match up with our filenames; and
# convert from arrays of values to flat strings, for
# consistency with what we are retrieving from file
$existingdocument{language} =
"$existingdocument{language_id}[0] ".
"$existingdocument{language_id}[1]";
$existingdocument{docgroup} =
"$existingdocument{doc_group}[0] ".
"$existingdocument{doc_group}[1]";
$existingdocument{state} =
"$existingdocument{stateid}[0] ".
"$existingdocument{stateid}[1]";
# Replace $document values with those we just retrieved,
# for the fields we are not modifying
my $field;
foreach $field (@validtypes) {
if (($field ne "all") && ($field ne $config{modify})) {
$document{$field} = $existingdocument{$field};
}
}
}
# Convert id/value strings to arrays
my @language_data = split(/\s+/, $document{language});
my @docgroup_data = split(/\s+/, $document{docgroup});
my @state_data = split(/\s+/, $document{state});
util_output("verbose", "Performing modification of document.");
# Write the content to DocManager
my $res = request
(POST
$config{hosturl}. "/docman/admin/index.php",
content => [ 'mode' => 'docdoedit',
'group_id' => $config{groupid},
'docid' => $config{docid},
'title' => $document{title},
'description' => $document{summary},
'language_id' => $language_data[0],
'data' => $document{body},
'doc_group' => $docgroup_data[0],
'stateid' => $state_data[0],
]
);
# Check to see if we failed to get a result from the server
if (!$res->is_success) {
util_output("verbose", "Failed to delete docgroup.");
util_output("die", "$res->as_string", "1");
}
# Check to see if our result contained the success phrase
my $submitresult = $res->content;
(my $modifiedhtml = $submitresult) =~ s/Document(.*)updated//;
if ($modifiedhtml ne $submitresult) {
util_output("verbose", "Completed modify ".
"successfully, per result page.");
} else {
# FIXME: could probably use some debugging info here
util_output("die", "Modify operation failed.", "1");
}
# FIXME: Do we need to verify that the content has been written
# properly by doing a manual comparison?
util_output("verbose", "Completed modification of document.");
}
#############################################################################
# end of package
#############################################################################
1;
syntax highlighted by Code2HTML, v. 0.9.1