Following code always print paths with double slashes:
use JSON;
use File::Spec;
my $installdir = $ENV{"ProgramFiles"};
my $xptrlc = File::Spec->catfile($installdir,"bin","sample");
my $jobhash;
my $return_packet;
$jobhash->{'PATH'} = $xptrlc;
$return_packet->{'JOB'} = $jobhash;
my $js = new JSON;
my $str = $js->objToJson($return_packet);
print STDERR "===> $str \n";
OUTPUT of this script is
===> {"JOB":{"PATH":"C:\\Program Files (x86)\\bin\\sample"}}
Any solution to remove those double \\ slashes?
As Greg mentioned, the '\' character is represented as '\\' in JSON.
http://www.ietf.org/rfc/rfc4627.txt?number=4627
If you intend to use "thaw" the JSON somewhere, like in another Perl program or in JavaScript, you will still get back exactly what you put in.
Are you trying to do something else with your JSON?
Windows is perfectly fine with using '/' in paths if that bothers you so much:
use strict; use warnings;
use JSON;
use File::Spec::Functions qw(catfile);
my $installdir = $ENV{ProgramFiles};
my $xptrlc = catfile $installdir,qw(bin sample);
$xptrlc =~ s'\\'/'g;
my $packet = { JOB => { PATH => $xptrlc } };
my $js = JSON->new;
my $str = $js->encode($packet);
warn "===> $str \n";
Output:
===> {"JOB":{"PATH":"C:/Program Files/bin/sample"}}
On the other hand, the encoded value will be correctly decoded:
use JSON;
warn JSON->new->decode(scalar <DATA>)->{JOB}->{PATH}, "\n";
__DATA__
{"JOB":{"PATH":"C:\\Program Files (x86)\\bin\\sample"}}
Output:
C:\Temp> ht
C:\Program Files (x86)\bin\sample
Related
im using this perl code to transform JSON into other form with some regular expressions:
use strict;
use warnings;
use feature 'say';
use JSON;
use utf8;
my %IDs = ( 'User awx01 logged in.' => 1001 );
my %levels = ( INFO => 4 );
my $data = <DATA>;
my $json = data2json($data);
my $record = decode_json($json);
say rec2msg($record);
sub data2json {
my $json = shift;
$json =~ s/[""]/"/g;
$json =~ s/\\//g;
$json =~ s/"(\{.*?\})"/$1/;
return $json;
}
sub rec2msg {
my $r = shift;
$r->{Message}{message} =~ /(\w+) (\w+) (.+)/;
my($user,$msg) = ($2,"$1 $3");
my $ID = $IDs{$r->{Message}{message}};
my $level = $levels{$r->{Message}{level}};
my $out = "$r->{Message}{'#timestamp'} host CEF:0|OpenSource|AWX|7.0.0|$ID|$msg|$level|src=127.0.0.1 dst=$r->{MessageSourceAddress} duser=$user";
return $out;
}
__DATA__
{"MessageSourceAddress":"192.168.81.20","EventReceivedTime":"2020-02-06 11:55:14","SourceModuleName":"udp","SourceModuleType":"im_udp","SyslogFacilityValue":1,"SyslogFacility":"USER","SyslogSeverityValue":5,"SyslogSeverity":"NOTICE","SeverityValue":2,"Severity":"INFO","EventTime":"2020-02-06 11:55:14","Hostname":"192.168.81.20","Message":"{\"#timestamp\": \"2020-02-06T08:55:52.907Z\", \"message\": \"User awx01 logged in.\", \"host\": \"awxweb\", \"level\": \"INFO\", \"logger_name\": \"awx.api.generics\", \"stack_info\": null, \"type\": \"other\", \"cluster_host_id\": \"awx-contr-01\", \"tower_uuid\": \"333b4131-495f-4460-8e4b-890241a9d73d\"}"}
But im getting this error:
2020-03-31 20:48:50 ERROR perl subroutine rec2msg failed with an error: 'Can't use string ("140511667030448") as a HASH ref while "strict refs" in use at /usr/libexec/nxlog/modules/extension/perl/event1.pl line 21.;'
What im doing wrong? How could i solve it?
You have JSON embedded in JSON, so you need to decode it twice. This often happens when you have one service passing through the response for another service.
Your data2json wasn't decoding that second level, so the value for the Message name was still a string. Since that value wasn't a hash reference, you get the error you reported.
You don't want to use a bunch of substitutions on the entire thing because you can inadvertently change things you shouldn't be messing with. Decode the top level just as you did, but then do the same thing for the Message value:
# read in all the data, even though it looks like a single line. Maybe it won't be later.
my $data = do { local $/; <DATA> };
# decode the first layer
my $decoded = decode_json( $data );
# decode the Message value:
$decoded->{Message} = decode_json( $decoded->{Message} );
Now, when you call rec2msg it should work out.
Note that this has the opposite problem to reverse it. You can't merely encode the entire thing to JSON again. The value for Message still needs to be a string, so you have to encode that first if you want to send it somewhere else. If you are doing that, you probably want to work on a copy. I use dclone to make a deep copy so whatever I do to $encoded does not show up in $decoded:
# make a deep copy so nested references aren't shared
use Storable qw(dclone);
my $encoded = dclone( $decoded );
$encoded->{Message} = encode_json( $encoded->{Message} );
my $new_data = encode_json( $encoded );
Then $new_data will have the same escaping as the original input.
Here it is altogether:
use strict;
use warnings;
use feature 'say';
use JSON;
use utf8;
my %IDs = ( 'User awx01 logged in.' => 1001 );
my %levels = ( INFO => 4 );
# read in all the data, even though it looks
my $data = do { local $/; <DATA> };
my $decoded = decode_json( $data );
$decoded->{Message} = decode_json( $decoded->{Message} );
say rec2msg($decoded);
sub rec2msg {
my $r = shift;
$r->{Message}{message} =~ /(\w+) (\w+) (.+)/;
my($user,$msg) = ($2,"$1 $3");
my $ID = $IDs{$r->{Message}{message}};
my $level = $levels{$r->{Message}{level}};
my $out = "$r->{Message}{'#timestamp'} host CEF:0|OpenSource|AWX|7.0.0|$ID|$msg|$level|src=127.0.0.1 dst=$r->{MessageSourceAddress} duser=$user";
return $out;
}
I have a doubt I've been trying to solve myself using CPAN modules documentation, but I'm a bit new and I'm confused with some terminology and sections within the different modules.
I'm trying to create the object in the code below, and get the absolute URL for relative links extracted from a website.
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use Digest::MD5 qw(md5_hex);
use URI;
my $url = $ARGV[0];
if ($url !~ m{^https?://[^\W]+-?\.com/?}i) {
exit(0);
}
my $ua = LWP::UserAgent->new;
$ua->timeout( 10 );
my $response = $ua->get( $url );
my $content = $response->decoded_content();
my $links = URI->new($content);
my $abs = $links->abs('http:', $content);
my $abs_links = $links->abs($abs);
while ($content =~ m{<a[^>]\s*href\s*=\s*"?([^"\s>]+)}gis) {
$abs_links = $1;
print "$abs_links\n";
print "Digest for the above URL is " . md5_hex($abs_links) . "\n";
}
The problem is when I try to add that part outside the While loop (the 3-line block preceding the loop), it does not work, whereas if I add the same part in the While loop, it will work fine. This one just gets the relative URLs from a given website, but instead of printing "Http://..." it prints "//...".
The script that works fine for me is the following:
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use Digest::MD5 qw(md5_hex);
use URI::URL;
my $url = $ARGV[0]; ## Url passed in command
if ($url !~ m{^https?://[\w]+-?[\w]+\.com/?}i) {
exit(0); ## Program stops if not valid URL
}
my $ua = LWP::UserAgent->new;
$ua->timeout( 10 );
my $response = $ua->get( $url ); ## Get response, not content
my $content = $response->decoded_content(); ## Now let's get the content
while ($content =~ m{<a[^>]\s*href\s*=\s*"?([^"\s>]+)}gis) { ## All links
my $links = $1;
my $abs = new URI::URL "$links";
my $abs_url = $abs->abs('http:', $links);
print "$abs_url\n";
print "Digest for the above URL is " . md5_hex($abs_url) . "\n";
}
Any ideas? Much appreciated.
I don't understand your code. There are a few weird bits:
[^\W] is the same as \w
The regex allows an optional - before and an optional / after .com, i.e. http://bitwise.complement.biz matches but http://cool-beans.com doesn't.
URI->new($content) makes no sense: $content is random HTML, not a URI.
$links->abs('http:', $content) makes no sense: $content is simply ignored, and $links->abs('http:') tries to make $links an absolute URL relative to 'http:', but 'http:' is not a valid URL.
Here's what I think you're trying to do:
#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use HTML::LinkExtor;
use Digest::MD5 qw(md5_hex);
#ARGV == 1 or die "Usage: $0 URL\n";
my $url = $ARGV[0];
my $ua = LWP::UserAgent->new(timeout => 10);
my $response = $ua->get($url);
$response->is_success or die "$0: " . $response->request->uri . ": " . $response->status_line . "\n";
my $content = $response->decoded_content;
my $base = $response->base;
my #links;
my $p = HTML::LinkExtor->new(
sub {
my ($tag, %attrs) = #_;
if ($tag eq 'a' && $attrs{href}) {
push #links, "$attrs{href}"; # stringify
}
},
$base,
);
$p->parse($content);
$p->eof;
for my $link (#links) {
print "$link\n";
print "Digest for the above URL is " . md5_hex($link) . "\n";
}
I don't try to validate the URL passed in $ARGV[0]. Leave it to LWP::UserAgent. (If you don't like this, just add the check back in.)
I make sure $ua->get($url) was successful before proceeding.
I get the base URL for absolutifying relative links from $response->base.
I use HTML::LinkExtor for parsing the content, extracting links, and making them absolute.
I think your biggest mistake is trying to parse links out of HTML using a regular expression. You would be far better advised to use a CPAN module for this. I'd recommend WWW::Mechanize, which would make your code look something like this:
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use WWW::Mechanize;
use Digest::MD5 qw(md5_hex);
use URI;
my $url = $ARGV[0];
if ($url !~ m{^https?://[^\W]+-?\.com/?}i) {
exit(0);
}
my $ua = WWW::Mechanize->new;
$ua->timeout( 10 );
$ua->get( $url );
foreach ($ua->links) {
say $_->url;
say "Digest for the above URL is " . md5_hex($_->url) . "\n";
}
That looks a lot simpler to me.
I am using Path::Class::Rule for getting absolute path of required file .
As my file name either have UILogs[_d]* or log.main format. Below is the code which i am using
Code :
use warnings;
BEGIN {
eval { require Path::Class::Rule }
or system("ppm install Path::Class::Rule");
}
use Path::Class;
use Path::Class::Rule;
use Cwd qw();
use File::Path qw(make_path);
use File::Copy;
my $root = "logpath";
my #uiLogDirs = grep { -d $_ && !/A\.\.?\z/ } dir($root)->children();
my $iter = Path::Class::Rule->new->file->name(qr/ UILogs[_d]* | log.main/)->iter(#uiLogDirs);
while ( my $uifilepath = $iter->() ) {
print "$uifilepath\n";
}
But above code is not working i.e unable to search the file. It is working fine if i am using
my $iter = Path::Class::Rule->new->file->name(qr/log.main/)->iter(#uiLogDirs);
Logs file Example:
Monkey_SDCard_UILogs_141008_154230
log.main
Can anyone help me out in the above issue?
Spaces are significant in regular expressions unless you use the /x modifier:
qr/UILogs[_d]*|log\.main/
qr/ UILogs[_d]* | log\.main /x
BTW, I'm not sure about the first alternative. Do you really have filenames like UILogs___d_?
I'm new to programming, learning perl as well.
Here's my question: How do I search a string in web page and print that full line in which search string is present?
Is it possible to find/hit directly that string and then print that full line in which search string is present? Do we need to use xpaths compulsory for this?
If it is just a very basic string you are looking for you can use LWP::Simple and a small regular expression like this:
use LWP::Simple;
my $doc = get('http://stackoverflow.com/q/11771655/479133') || die "GET failed";
foreach my $line (split("\n", $doc)) {
print $line and last if $line =~ m/Here's my query/;
}
There are countless modules available on CPAN to do such things. Have a look at Task::Kensho::WebCrawling if you need something "bigger".
LWP::UserAgent and HTML::Parser can be used:
#!/usr/bin/env perl
use strict;
use warnings;
use HTML::Parser;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
my $response = $ua->get('http://search.cpan.org/');
if ( !$response->is_success ) {
print "No matches\n";
exit 1;
}
my $parser = HTML::Parser->new( 'text_h' => [ \&text_handler, 'dtext' ] );
$parser->parse( $response->decoded_content );
sub text_handler {
chomp( my $text = shift );
if ( $text =~ /language/i ) {
print "Matched: $text\n";
}
}
I am trying to find a RSS parser that can be used with a Perl CGI script. I found simplepie and that's really easy parser to use in PHP scripting. Unfortunately that doesn't work with a Perl CGI script. Please let me know if there is anything that's easy to use like simplepie.
I came across this one RssDisplay but I am not sure about the usage and also how good it is.
From CPAN: XML::RSS::Parser.
XML::RSS::Parser is a lightweight liberal parser of RSS feeds. This parser is "liberal" in that it does not demand compliance of a specific RSS version and will attempt to gracefully handle tags it does not expect or understand. The parser's only requirements is that the file is well-formed XML and remotely resembles RSS.
#!/usr/bin/perl
use strict; use warnings;
use XML::RSS::Parser;
use FileHandle;
my $parser = XML::RSS::Parser->new;
unless ( -e 'uploads.rdf' ) {
require LWP::Simple;
LWP::Simple::getstore(
'http://search.cpan.org/uploads.rdf',
'uploads.rdf',
);
}
my $fh = FileHandle->new('uploads.rdf');
my $feed = $parser->parse_file($fh);
print $feed->query('/channel/title')->text_content, "\n";
my $count = $feed->item_count;
print "# of Items: $count\n";
foreach my $i ( $feed->query('//item') ) {
print $i->query('title')->text_content, "\n";
}
Available Perl Modules
XML::RSS::Tools
XML::RSS::Parser:
#!/usr/bin/perl -w
use strict;
use XML::RSS::Parser;
use FileHandle;
my $p = XML::RSS::Parser->new;
my $fh = FileHandle->new('/path/to/some/rss/file');
my $feed = $p->parse_file($fh);
# output some values
my $feed_title = $feed->query('/channel/title');
print $feed_title->text_content;
my $count = $feed->item_count;
print " ($count)\n";
foreach my $i ( $feed->query('//item') ) {
my $node = $i->query('title');
print ' '.$node->text_content;
print "\n";
}
XML::RSS::Parser::Lite (Pure Perl):
use XML::RSS::Parser::Lite;
use LWP::Simple;
my $xml = get("http://url.to.rss");
my $rp = new XML::RSS::Parser::Lite;
$rp->parse($xml);
print join(' ', $rp->get('title'), $rp->get('url'), $rp->get('description')), "\n";
for (my $i = 0; $i < $rp->count(); $i++) {
my $it = $rp->get($i);
print join(' ', $it->get('title'), $it->get('url'), $it->get('description')), "\n";
}
dirtyRSS:
use dirtyRSS;
$tree = parse($in);
die("$tree\n") unless (ref $tree);
disptree($tree, 0);