Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
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
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
4 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. :)

File reade and recreate
2 direct replies — Read more / Contribute
by adriang
on Aug 20, 2014 at 03:48

    Hi all,

    I want to create a counter using a file but this don't work

    #!/usr/bin/perl use warnings; use strict; use Carp; open(my $count_file,"+<","count.txt") or croak "cant open"; my $count=<$count_file>; $count++; print $count_file $count; print $count; __END__

    only this work:

    #!/usr/bin/perl use warnings; use strict; use Carp; open(my $count_file,"<","count.txt") or croak "cant open"; my $count=<$count_file>; $count++; open($count_file,">","count.txt") or croak "cant open"; print $count_file $count; print $count; __END__

    I want to use OPEN only once.

    Thanks in advace, Adrian.

parsing the Windows directories
3 direct replies — Read more / Contribute
by g_speran
on Aug 19, 2014 at 16:22

    Hello All,

    I am trying to write a script that would parse thru a windows directory supplied and return the object type encountered (File, Directory, Link, etc), size, atime, ctime, and mtime.

    I located some code on the internet that kinda works, but when it gets to a windows link/shortcut (.lnk), the script fails with:

    Use of uninitialized value in bitwise and (&) at C:\temp\showmodes.pl line 5.

    Can't stat() 'C:\Users\admin\Favorites\MSN Websites\MSN Autos'

    Any thoughts on how to parse thru all object type and it return the appropriate information?

    #!/usr/bin/perl use strict; use warnings; my $name = shift or die "Usage: $0 file|directory\n"; my $mode = ( ( lstat($name) )[2] ) & 07777 or die "Can't stat() '$name +'\n"; printf "%s %04o %s\n", ( -f _ ) ? 'f' : ( -l _ ) ? 'l' : ( -d _ ) ? 'd' : ( -b _ ) ? 'b' : ( -c _ ) ? 'c' : ( -p _ ) ? 'p' : ( -S _ ) ? 's' : '?', $mode, $name; 1;

HTML Parsing (ick)
5 direct replies — Read more / Contribute
by dbarron
on Aug 19, 2014 at 14:55
    Ok, I need to parse webpages (that I wrote, but has been modified by others), and extract pertinent information stored within <div> </div> tags of class 'listing'. I'll list a sample entry below and then detail what I wish to parse out of it, with the format of another sample. Hopefully this will make sense and I'll gladly accept any advise as to which modules to use to make this easier.
    <div class="listing"> Agave parryi&nbsp;&nbsp;&nbsp;&nbsp; <span style="font-weight: normal;">Parry's agave</span> <br>$20.00&nbsp; 3 quart&nbsp;&nbsp;&nbsp; $12.00 Quart <br><span id="native">Native</span>&nbsp;&nbsp;&nbsp; Sun to part shade&nbsp; Zones 5-10&nbsp; Family: <i>Amaryllidaceae</i> <br>From the Southwest comes this lovely agave.&nbsp; Thick spiny leaves adorn this hardy agave.&nbsp; Ultimate clump size is about 36" with each leaf being maybe 5" across. The flower stalk can reach 12 feet tall. Please plant in well drained soil in a place where children don't play. <span id="hummingbird">Hummingbirds</span> </div>
    Ok, what I'd like to get out of this (and there's a lot more html junk around it to ignore) is:
    Latin name (ie agave parryi)
    Common name (Parry's agave)
    Pot price ($20.00)
    Pot size (3 quart)
    Pot price ($12.00)
    Pot size (quart)
    Origin: Native
    Exposure: Sun to part shade
    Hardiness: 5-10
    Family: Amaryllidacea
    Text description:From the Southwest comes this lovely agave.  Thick spiny leaves adorn this hardy agave.  Ultimate clump size is about 36" with each leaf being maybe 5" across. The flower stalk can reach 12 feet tall. Please plant in well drained soil in a place where children don't play.
    Special Features: Hummingbirds (there's others of those...but I can handle generalization (I think))
    Ok, sorry for such a long post...but I wanted to give a good thorough example.
Perl Concatenate vs Append Operator
5 direct replies — Read more / Contribute
by nande9
on Aug 19, 2014 at 12:14

    I have a somewhat general question about the Perl concatenate operator and the append operator.

    First, here is the example straight from Learning Perl (p.29)

    # append a space to $str $str = $str . " ";
    # same thing with assignment operator $str .= " ";

    My question: Are either of these method more "correct" or preferred for speed or syntactical reasons?

    Any information is greatly appreciated.

    -- Nick
New Meditations
How realistic is an extended absence?
11 direct replies — Read more / Contribute
by ksublondie
on Aug 15, 2014 at 13:17
    I've been working for the same small, local company since college (12 years -- CS degree) and the sole programmer for the last 7...5 of which have been almost exclusively from home. I love my job, the company is great, can't ask for a better boss, I'm able to work independently and come up with my own projects. But lately, I've been contemplating staying home* to watch the kiddos (currently 3 all <=5). I'm flat out burned out and my priorities have shifted.

    How realistic is it to quit my job for an extended adsence (5+ years) and later return to a programming/IT position? Am I going to be pigeon holed into the baby-track? Will I be untouchable & irrelavant?

    * EDIT: "staying at home" = quitting my job/programming. For clarification, I have been working at home full-time with the kiddos from day one. Always in the past, it worked rather well. It was all they ever knew. My parenting style is rather "hands off" (not to say I neglect my children, but I make sure their needs are met while teaching them to be independent and doing things for themselves if it's within their capability). As a result, they have amazing attention spands and are capable of entertaining themselves. Plus a fortune invested in baby gates helps. Toddlers running around are less distracting than my coworkers and all the drama, politics, meetings about the next meeting, etc.

    I don't know if it's the addition of #3, or their ages requiring more mental stimulation, or #2 being a yet-to-be-potty-trained holy terror...or a combination thereof...but it's not working so smoothly anymore. I'm debating about quitting completely. I can tell myself to "stay in the loop" independently, but realistically, I know I won't. I already feel irrelavant since I'm not physically in the office.

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 meditating upon the Monastery: (8)
As of 2014-08-21 16:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (138 votes), past polls