Re: Perl and bad characters - Progress!

[Bill Stephenson <bi...@cherrypc.com>]

As per the advice given I took a different route and used LWP to  get and put the document. 

And I’m going the ditch the building of the JSON like so:

my $returnJSON = qq`{"_id": "$_id", "_rev": "$_rev", "title": "$title", "subtitle": "$subtitle", "content": "$content", "docType": "text", "Text_publish": "yes", "publishDate": "$publishDate",$newCommentsList}`;

That just doesn’t work.  I don’t know why, but all I really need to do is add the comment to the Perl object so I’m going to work on that. Perl Objects do baffle me a bit but I’m going to try and trudge my way through figuring it out. 

Thank you all for the advice and pointers.

Below is what I’ve got so far and this does update the doc successfully so I have made progress with your help:
----------------------------------------------------------------------

#!/usr/bin/perl

use strict;
use warnings;
use JSON::XS;
use Data::Dumper;
use CGI;
use LWP::Simple;

my $cgi = CGI->new;
my $msg;

# Get and print the post doc ID:
my $id = $cgi->param('postID');    
# $msg = "id:  $id";
# &print_message($msg);  

# Get the blog post from CouchDB
my $url = "https://user:pass\@cherrypc.com:6984/cherrypc/$id";

my $blogdoc = get $url;
die "Couldn't get $url" unless defined $blogdoc;

# convert json to perl object
my $data_structure = decode_json($blogdoc);

$msg = "Doc Title: ". $data_structure->{'title'};
&print_message;

# -----------------------------------------
#Get the list of comments:

my %comments;
my $comments;
my @comments;
my $comment;
my $commentDate;
my $msgCounter = 1;
my $commentList;

$comments{ $_->{'comment'} } = $_->{'commentDate'} for @{ $data_structure->{'comments'} };

$msg = "Number of Comments: " . scalar keys %comments;
&print_message;

# Get and print old comments:
while ( ( $comment, $commentDate ) = each %comments ) { 
	$commentList .= "Comment: $comment :: Comment Date : $commentDate \n";
}

$msg = "Old Comments: \n" .$commentList; 
&print_message;

# Need to add the new comment to the $data_structure perl object here
my $newCommentDate = $cgi->param('commentDate');     
my $newComment = $cgi->param('comment');  

# Print new comment:
$msg = "New Comment: \nComment $newComment :: Comment Date : $newCommentDate";
&print_message($msg);

# I have no idea yet how to append the new comment to the Perl Object.
# Seems like this should be easy but I've yet to figure that out.

# -----------------------------------------
# convert perl object back to json 
my $updatedDoc = encode_json $data_structure;
# -----------------------------------------

# Update the document
my $req = HTTP::Request->new(PUT => $url);
$req->content_type('application/json');
$req->content($updatedDoc);

my $ua = LWP::UserAgent->new; 
my $res = $ua->request($req);
# $res is an HTTP::Response.

if ($res->is_success) {
    $msg = "Success: ". $res->as_string;
	&print_message($msg);
  }
  else {
    $msg =  "Failed: ". $res->status_line;
	&print_message($msg);
  }

# $msg = Dumper($res);
# &print_message($msg);

print $cgi->header('text/plain;charset=UTF-8');  
  
exit;

#--------------------------------------------------------------------------------------------------------
sub print_message {
#--------------------------------------------------------------------------------------------------------
	open (DUMPFILE, ">>/usr/lib/cgi-bin/debug.txt") or die "Unable to open /usr/lib/cgi-bin/debug.txt \n";
	print DUMPFILE "\n------------------- message ------------------- \n";
	print DUMPFILE "$msg";
	print DUMPFILE "\n--------------------- end --------------------- \n";
	close(DUMPFILE);
	$msg = "";
	return;
}

Re: Perl and bad characters - Solved!

[Bill Stephenson <bi...@cherrypc.com>]

I found the simple “append” solution I was looking for on stackoverflow.com:

https://stackoverflow.com/questions/21718486/need-to-add-new-data-to-json-array-in-perl <https://stackoverflow.com/questions/21718486/need-to-add-new-data-to-json-array-in-perl>

Thank you all again for the help!

I’ve included the working script below. If anyone has suggestions for improvements please let me know.

Kindest Regards,

Bill Stephenson


—————————————————————————
#!/usr/bin/perl

use strict;
use warnings;
use JSON::XS;
use Data::Dumper;
use CGI;
use LWP::Simple;

my $cgi = CGI->new;
my $msg;

# Get and print the post doc ID:
my $id = $cgi->param('postID');    
# $msg = "id:  $id";
# &print_message($msg);  

# Get the blog post from CouchDB
my $url = "https://user:pass\@cherrypc.com:6984/cherrypc/$id";

my $blogdoc = get $url;
die "Couldn't get $url" unless defined $blogdoc;

# convert json to perl object
my $data_structure = decode_json($blogdoc);
 
# $msg = "Doc Title: ". $data_structure->{'title'};
# &print_message;

# $msg = "data_structure: \n" . Dumper($data_structure);
# &print_message($msg);

# -----------------------------------------
#Append the list of comments:

my $newCommentDate = $cgi->param('commentDate');     
my $newComment = $cgi->param('comment');  

my $newdata = {commentDate=>"$newCommentDate",comment=>"$newComment"};
push @{ $data_structure->{'comments'}  }, $newdata;
# -----------------------------------------

# convert perl object back to json 
my $updatedDoc = encode_json $data_structure;

# Update the document
my $req = HTTP::Request->new(PUT => $url);
$req->content_type('application/json');
$req->content($updatedDoc);

my $ua = LWP::UserAgent->new; 
my $res = $ua->request($req);
# $res is an HTTP::Response.

if ($res->is_success) {
    $msg = "Success: ". $res->as_string;
    &print_message($msg);
  }
  else {
    $msg =  "Failed: ". $res->status_line;
    &print_message($msg);
  }

# $msg = Dumper($res);
# &print_message($msg);

print $cgi->header('text/plain;charset=UTF-8');  
  
exit;

#--------------------------------------------------------------------------------------------------------
sub print_message {
#--------------------------------------------------------------------------------------------------------
	open (DUMPFILE, ">>/usr/lib/cgi-bin/debug.txt") or die "Unable to open /usr/lib/cgi-bin/debug.txt \n";
	print DUMPFILE "\n------------------- message ------------------- \n";
	print DUMPFILE "$msg";
	print DUMPFILE "\n--------------------- end --------------------- \n";
	close(DUMPFILE);
	$msg = "";
	return;
}