Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

The Monastery Gates

( #131=superdoc: print w/ replies, xml ) Need Help??

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
find date given day weekday and a range of months
3 direct replies — Read more / Contribute
by kimlid2810
on Aug 22, 2014 at 15:32
    greetings monks i have a slightly bizarre problem and i would be grateful if someone can offer some advice. i have 3 data. the day of a month eg: 28, the corresponding weekday eg: Thu, the year eg: 2014 and a range of three months eg: Aug, Sep, Oct like this:
    my $day = 28; my $weekday = 'Thu'; my $year = '2014'; my @months = ('Aug', 'Sep', 'Oct');
    Is there anyway i can figure out the exact date? Any module that would take this data and return something like:
    my $date = '2014-09-28';
    Any algorithm known or any advice? Thank you :)
decoding pattern expression
3 direct replies — Read more / Contribute
by randome
on Aug 22, 2014 at 10:10
    Hello, I have a huge file with over 700,00 entries with 18 columns. One column is in the format
    --+-+ ---++ ????? -????
    Now i have another list which corresponds to this code in a particular order
    A-1 B-7 C-11 D-3 E-100
    Now I need to match the expression above to the pattern, where +/- corresponds to A-E and ? corresponds to 0 and as an output I need to get a number. So the output should be
    --+-+ = 122 (because 1+7+11+3+100) ---++= 122 ?????= 0 -???+= 101
    This is just a sample, the numbers are much bigger and the pattern runs upto 24 times. Is there any way I can do it with perl scripting ? Thank you
Reading source code: mapping of function calls
1 direct reply — Read more / Contribute
by szabgab
on Aug 22, 2014 at 06:16
    When reading source code I often would like to have a feeling of which function calls which function (or method). Is there a tool that can show a mapping of the call hierarchy? Using statical analysis.
Web Service error
1 direct reply — Read more / Contribute
by chuck882
on Aug 21, 2014 at 09:40

    Hello, I am very new to Perl and I want to create a Perl web service that accepts a SOAP message, grabs the XML as a text block and saves it in a DB. To do this I created two simple Perl stubs to send an XML doc to a very simple web service. However, I only get an error saying cannot access member in main. I looked this up and only seem to find very generic reasons of which none seem to apply. Below is the very simple code I have written. I am using Strawberry PERL via IIS. Code to send the SOAP message is below. I use a predefined string for the message as I want to swap out many different SOAP messages for testing.

    #!perl use HTTP::REQUEST; use LWP::UserAgent; #print "Hello there\n"; my $useragent = LWP::UserAgent->new(agent => 'Perl Post'); my $message = '<?xml version="1.0"?><soap:Envelope xmlns:soap="http:// +localhost"><soap:Header></soap:Header><soap:Body><soap:Method>Demo</s +oap:Method></soap:Body></soap:Envelope>'; my $response = $useragent->post('http://localhost/read_xml.pl',Content +_Type => 'text/xml', Content => $message); print $response->as_string; exit;
    My very simplistic server code is below. Again, eventually I want to grab the XML as text but cannot even get it to connect without the error right now. I have also made Demo a class and called it as such but that did not change the error. Any ideas would be appreciated.
    #!perl use SOAP::Lite; use SOAP::Transport::HTTP; #print "Content-type: text/plain\n\n"; SOAP::Transport::HTTP::CGI -> dispatch_to('Demo') -> handle; package Demo; print "Content-type: text/plain\n\n"; print "This is a test\n"; my $argument = pop; print "Argument is: $argument\n"; exit;
ImageMagick - why do these snippets act differently?
1 direct reply — Read more / Contribute
by pete_l
on Aug 21, 2014 at 09:30
    There is a small piece of code that does what I expect it to:
    #!/usr/bin/perl use Image::Magick; $ipimage = Image::Magick->new(size=>'640x480'); $ipimage->Read("logo:"); $blob1=$ipimage->ImageToBlob(); $opimage = Image::Magick->new(size=>'640x480'); $opimage->BlobToImage($blob1); $opimage->Write("t1.jpg");
    It writes a JPEG of the ImageMagick logo. Here is a second piece of code. The only difference is that I have specified an RGB format for the image:
    #!/usr/bin/perl use Image::Magick; $ipimage = Image::Magick->new(size=>'640x480'); $ipimage->Set(magick=>'RGB'); $ipimage->Read("logo:"); $blob1=$ipimage->ImageToBlob(); $opimage = Image::Magick->new(size=>'640x480'); $opimage->Set(magick=>'RGB'); $opimage->BlobToImage($blob1); $opimage->Write("t2.jpg");
    In this case, the output is still a 640x480 JPEG image. However, the icon is a quarter the size, it's repeated in the top left and right quadrants (the lower half of the image being black) and the image colours are wrong.

    I have looked for any worked examples of BlobToImage and come up with nothing. What documentation I have found seems to be abstract API definitions, but without enough information to say for sure if I'm calling it correctly. I'd really appreciate someone explaining to me why I get these different outputs, and how to call BlobToImage for an RGB image (since I need to manipulate the individual colour pixels and GetPixel/SetPixel is far too slow) to create the sort of output that the first code example gives.

    With thanks

Uninitialized value in substr command
5 direct replies — Read more / Contribute
by lmtaylor
on Aug 20, 2014 at 17:09

    Hello. I'm trying to take a very large array and re-format it. The initial array looks something like this:

    >123

    ABD

    CEF

    GHI

    >456

    JKL

    MNO

    >789

    That's obviously simplified, but that's the idea. I want to join the elements between the two lines that begin with '>' and then get rid of the lines that begin with the '>', so my final array looks something like this:

    ABDCEFGHI

    JKLMNO

    Here is the code I've written to do it. My problem is, every time I run it, I get a million errors that all say "Use of uninitialized value in substr at line 19." But I can't figure out what value it's talking about.

    #!/usr/bin/perl -w my @contigfile = (">37","ABC","DEF","GHI","JKL","MNO","PQR","STU","VWX +","YZ",">38"); my $element1 = 0; my $element2 = 0; # print @contigfile; # print substr($contigfile[$element1],0,1); # print $contigfile[$element1]; while ($contigfile[$element1]){ if (substr($contigfile[$element1], 0, 1) eq '>'){ do { ++$element2; } until (substr($contigfile[$element2], 0, 1) eq '>'); $new = join('',@contigfile[($element1 + 1)..($element2 - 1)]); splice @contigfile, $element1, $element2, "$new"; ++$element1; $element2 = $element1; } } print @contigfile; exit;

    I wrote this code to test my method before implementing it in my real program, which will take the array in from an input file. Only I can't figure out what this error is talking about. The commented out print commands work just fine. Does anyone see something that I'm missing?

    Thank you so much for your help!

    - Lisa

Check if a file exists and if not create it
5 direct replies — Read more / Contribute
by Wroof
on Aug 20, 2014 at 16:51

    Good morning Monks,

    I am trying to write up a short test program to learn how to deal with files in Perl before I try and implement it into a program I have already written.

    The idea of the test program is to open a file for appending and if the file does not exist create it and open it. The software in the end will be used to create a log in another program to help me track down an error that is occurring around once every 40-50 days.

    What I have at the moment is just trying to open a file for appending/create the file, and then close the file before testing that it exists. This is all based on the IO:File Lib. The function $fh->open(">> test2.txt") always seams to return true even if the files does not exist and it does not create it either.

    use IO::File; use strict; my $fh; sub test { my $filename = 'test2.txt'; unless (-f $filename) { print "File Exists!"; } else { print "File does not exist"; } } sub openFile { $fh = IO::File->new(); if ($fh->open(">> test2.txt")) { print "file open"; print <$fh>; $fh->close; } else { print "file failed to open"; } } openFile(); test();
Dumb question...probably...
2 direct replies — Read more / Contribute
by kepler
on Aug 20, 2014 at 15:11
    Hello, I'm trying to assign variables to a DateTime module like this:
    $dt = DateTime->new( year => $year, month => $month, day => $day, hour => $hour, minute => $minutes, second => $seconds, );
    which gives undef to all variables, although the values are not empty. Sorry to ask: but how do I do this right? Kind regards, Kepler
Multiple File Handles open and active
No replies — Read more | Post response
by tnteverett
on Aug 20, 2014 at 14:53
    http://cpansearch.perl.org/src/SULLR/Net-Inspect-0.303/tools/rtpxtract.pl

    This files uses "$self->{$fh}" to identify file handles for writing. the problem is I need an infinite number to be available while I read RTP and extract any number of separate audio streams to be written to separate audio files

    How is this variable assigned and how do I open multiple file handles for the streams as they are detected in the RTP?

    My version of the code is attached below.

    This code produces only two file handles for the first and second SSRC values.
    #!/usr/bin/perl use strict; use warnings; use Socket; use Getopt::Long qw(:config posix_default bundling); #use Net::Pcap qw(:functions); use Net::Pcap; use Net::Inspect::Debug qw(:DEFAULT %TRACE $DEBUG); use Net::Inspect::L2::Pcap; use Net::Inspect::L3::IP; use Net::Inspect::L4::UDP; ###################################################################### +###### # Options ###################################################################### +###### my ($infile,$dev,$nopromisc,@trace,$outdir); GetOptions( 'r=s' => \$infile, 'i=s' => \$dev, 'p' => \$nopromisc, 'h|help' => sub { usage() }, 'd|debug' => \$DEBUG, 'T|trace=s' => sub { push @trace,split(m/,/,$_[1]) }, 'D|dir=s' => \$outdir, ) or usage(); usage('only interface or file can be set') if $infile and $dev; $infile ||= '/dev/stdin' if ! $dev; my $pcapfilter = join(' ',@ARGV); $TRACE{$_} = 1 for(@trace); die "cannot write to $outdir: $!" if $outdir and ! -w $outdir || ! -d +_; sub usage { print STDERR "ERROR: @_\n" if @_; print STDERR <<USAGE; reads data from pcap file or device and extracts rtp streams. Depending on the used codec you might use to convert data afterwards. For G711a: sox -c1 -r8000 -t al in.rtp out.wav Usage: $0 [options] [pcap-filter] Options: -h|--help this help -r file.pcap read pcap from file -i dev read pcap from dev -p do net set dev into promisc mode -D dir extract data into dir, right now only for http re +quests and responses -T trace trace messages are enabled in the modules, option + can be given multiple times, trace is last part of mo +dule name, e.g. tcp, rawip To enable all specify '*' -d|--debug various debug messages are shown USAGE exit(2); } # open pcap ###################################################################### +###### my $err; print "Open PCAP File: $infile\n"; my $pcap = $infile ? pcap_open_offline($infile,\$err) : pcap_open_live +($dev,2**16,!$nopromisc,0,\$err); $pcap or die $err; if ( $pcapfilter ) { print "Apply PCAP Filter: $pcapfilter\n"; pcap_compile($pcap, \(my $compiled), $pcapfilter,0,0xffffffff) == +0 or die "bad filter '$pcapfilter'"; pcap_setfilter($pcap,$compiled) == 0 or die; } # parse hierarchy ###################################################################### +###### my $udp = Net::Inspect::L4::UDP->new(XTract->new); my $raw = Net::Inspect::L3::IP->new($udp); my $pc = Net::Inspect::L2::Pcap->new($pcap,$raw); # Mainloop ###################################################################### +###### my $time; print "Begin Main Loop\n"; pcap_loop($pcap,-1,sub { my (undef,$hdr,$data) = @_; if ( ! $time || $hdr->{tv_sec}-$time>10 ) { $udp->expire($time = $hdr->{tv_sec}); } return $pc->pktin($data,$hdr); },undef); package XTract; use base 'Net::Inspect::Connection'; use Net::Inspect::Debug; use Data::Dumper; my %rtp; sub pktin { my ($self,$data,$meta) = @_; my $m; # are these expected RTP data? print "Check for expected data\n"; my $s = XTract::RTPStream->new($meta,$m); $s->pktin(0,$data,$meta->{time}); return $s; # no connection for packets return; } package XTract::RTPStream; use base 'Net::Inspect::Connection'; use Net::Inspect::Debug; use fields qw(meta fh0 fh1 fh2 fh3); use Data::Dumper; sub new { my ($class,$meta) = @_; #print Dumper(@_); return bless { meta => $meta }, $class; } sub pktin { my ($self,$dir,$data,$time) = @_; #print Dumper(@_); $self->{expire} = $time + 30; # short expiration #print Dumper($self); # extract payload from RTP data my ($vpxcc,$mpt,$seq,$tstamp,$ssrc) = unpack( 'CCnNN',substr( $dat +a,0,12,'' )); print "Dir: $dir\n"; my $fh = "fh$dir"; print "fh: $fh\n"; if ( ! $self->{$fh} ) { my $fname = sprintf "$outdir/%x-%s.%d-%s.%d-%08x.rtp", @{$self +->{meta}}{qw(time saddr sport daddr dport)},$ssrc; open( $self->{$fh},'>',$fname) or die $!; } my $version = ($vpxcc & 0xc0) >> 6; #if ( $version != 2 ) { # debug("RTP version $version"); # return #} print sprintf("RTP Version %s, VPXCC: %s, MPT: %s, SEQ: %s, TS: %s +, SSRC: %08x\n",$version,$vpxcc,$mpt,$seq,$tstamp,$ssrc); # skip csrc headers my $cc = $vpxcc & 0x0f; substr( $data,0,4*$cc,'' ) if $cc; # skip extension header my $xh = $vpxcc & 0x10 ? (unpack( 'nn', substr( $data,0,4,'' )))[1 +] : 0; substr( $data,0,4*$xh,'' ) if $xh; # ignore padding my $padding = $vpxcc & 0x20 ? unpack( 'C', substr($data,-1,1)) : 0 +; my $payload = $padding ? substr( $data,0,length($data)-$padding ): + $data; # XXX if data are lost filling might be useful # XXX no duplicate detection sleep 1; syswrite($self->{$fh},$payload); return; }
Example rtpextract does not compile
1 direct reply — Read more / Contribute
by tnteverett
on Aug 20, 2014 at 10:15
    http://cpansearch.perl.org/src/SULLR/Net-Inspect-0.303/tools/rtpxtract.pl

    I am not able to resolve a Line 62 Error:

    rtpextract.pl

    Undefined subroutine &main::pcap_open_offline called at ~/bin/rtpextract.pl line 62.

    Anyone know what the problem is here?

    PROBLEM RESOLVED: See responses

Formatting JSON the right way
3 direct replies — Read more / Contribute
by Anonymous Monk
on Aug 20, 2014 at 07:56
    Hi Monks!

    I am working on this code where I need to send json back to some jQuery code. I would like to know if there is better way of doing this, I mean formatting JSON data. Is there anything that could be done better?
    Here is the code sample for your evaluation:
    !/usr/bin/perl use strict; use warnings; use CGI::Carp qw(fatalsToBrowser); use CGI qw(-oldstyle_urls :standard); use DBI; use DBD::ODBC; use Data::Dumper; use JSON; my $q = CGI->new; my $search = $q->param('search') || ""; my $user = "user"; my $pwd = "pwd"; my $dbh = DBI->connect("DBI:ODBC" ,$user ,$pass ,{ PrintError => 0 } ) + or die "Can not connect to ODBC database: $DBI::errstr\n +" ; my $sql = qq{SELECT name,city,state from mytable where name like ? lim +it 5}; my $data_handle = $dbh->prepare($sql); $data_handle->execute($search.'%') or die "SQL Error: $DBI::errstr\ +n"; my %returned_data; while (my $row = $data_handle->fetchrow_hashref()) { $returned_data{'name'} = $row->{NAME}; $returned_data{'city'} = $row->{CITY}; $returned_data{'state'} = $row->{STATE}; } $data_handle->finish; print $q->header(-type => "application/json", -charset => "utf-8"); my $json = encode_json \%returned_data; print $json;

    Thanks for looking!
Threading Web Requests with LWP
2 direct replies — Read more / Contribute
by tip120
on Aug 20, 2014 at 05:23

    Hi there,

    I have a perl-curses based script that essentially connects to a web-based ajax powered chatroom. This script simply allows me to use the chatroom from within my terminal, without needing a web browser. It works, however, I have a small issue.

    It seems when a web request is made, the curses UI just freezes until the request is done. I figure I can solve this by making the web requests fork off into another thread.

    I've tested the code and confirmed that it only happens while waiting for the webserver to respond.

    However, I'm not sure about the easiest way to fix this. I'm using LWP for my web requests. Is there an easy way to make all the LWP HTTP requests thread and return back without having to rewrite a large portion of my code? Is there an easier way to solve the issue? Any advice would appreciated. :)

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (5)
As of 2014-08-23 09:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (173 votes), past polls