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 ########################################################################### # 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}} = ; 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;