Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Seekers of Perl Wisdom

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

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
Input Validation and pattern matching in Template Toolkit
2 direct replies — Read more / Contribute
by dipit
on Jun 20, 2018 at 03:57
    [% META title = 'Add xyz' %] [% attack = params.taskid_login %] [% IF attack.search('<script>') || attack.search('</script>') || attac +k.search('alert') %] [% attack = params.taskid_login | uri | html %] [% ELSE %][% attack = params.taskid_login %] <p> To add a new task ID member to <b>[% attack %]</b>, select one or +more users from the table below. </p> [% WRAPPER filter.tt filterTitle='Users filter' filterAction='add_task +id_member' %] [% INCLUDE form_textfield.tt fieldName='filter_login' fieldValue=p +arams.filter_login maxLength=100 %] [% END %] [%# Show global message is one or more members have been added... %] [% IF NumberOfAddedRecords %] [% INCLUDE global_message.tt globalMessage=NumberOfAddedRecords _ +' users have been added.' %] [% END %] [% INCLUDE form_table.tt table=PossibleMembersTable %]

    Hello All. Here i have created a varibale named "attack" and checking some validation over it. params.taskid_login is the input value to "attack" variable here. I want to detect <script> and alert tags here. I think my syntax is wrong so my page containing this template is not loading. Please help?

win32::serial problem
No replies — Read more | Post response
by spencoid
on Jun 20, 2018 at 00:34
    I finally figured out how to send and receive data to/from my RS232 Balance. It was a struggle to get the correct parameters etc. Now I have a perl script sort of working but there is a major problem. The code below is written as a TKX program. All it does is send hex strings to the scale to make it report back and also to operate the tare function. It works but only once every time I open the program. Multiple clicks on the read button (calls a sub to send characters) after the first return nothing. Tare button does nothing unless it is the first thing done after the program starts and then the scale does not respond until the program is closed. I have looked over win32::serial over and over and tried everything i could think of but nothing changes. The communication is working because the scale does report one value or does on tare operation when the program closes. sorry for all the TK stuff getting in the way. At the end is a bare bones version but it does not work for my testing because the script ends after each sent character.
    #!/usr/bin/perl -w use strict; use Tkx; use Win32::SerialPort; use Cwd; use File::Copy; my $path = getcwd; my $read_scale; my $main_back_color = "#EAC9E0"; my $backcolor = "#E798FF"; my $active_color = "#D4D0C8"; my $scale; my $maintitle = "Read Sartorius"; my $version = " version 1.000"; Tkx::catch("console hide"); my $mw = Tkx::widget->new("."); $mw->g_wm_resizable(0,0); $mw-> g_wm_title($maintitle); $mw->g_grid_columnconfigure(0, -weight => 1); $mw->g_grid_rowconfigure(0, -weight => 1); Tkx::font_create("headtext_font",-size => 14); Tkx::font_create("scale_font",-size => 10); Tkx::font_create("bold_label_font", -size => 12, -weight=> 'bold'); Tkx::font_create("small_button_font", -size => 6,-weight=> 'normal'); my $menu = $mw->new_menu; $mw->configure(-menu => $menu); my $std_fncts = $menu->new_menu; my $test = $menu->new_menu; $menu->add_cascade(-menu => $test, -label => "Help"); $test->add_command(-label => "no Help yet", -command => sub {fill_help("F");do_help(25,100);}); $menu->add_command(-label => "Exit", -command => sub{\&clean_exit()}); my $frame0 = $mw-> new_frame(-relief=>'raised',-borderwidth=>2,-bd=>1, +-background=> "$backcolor"); $frame0->g_grid(-column =>0, -row => 0,-sticky => "ns"); my $buttons = $frame0-> new_frame(-bd=>2,-relief=>'raised',-relief=>'r +aised'); #,-background =>$check_button_color); $buttons->g_grid(-column =>0,-rowspan => 2, -row => 4,-sticky => "nsew +"); my $readbut = $buttons->new_button (-text => "Read", , -width=> 11,-co +mmand => sub {read_scale();}, -background => "green", -activebackgrou +nd => "red", -pady => 5, -padx => 6); $readbut -> g_grid(-column =>0, -row => 0, -sticky => "E"); my $tarebut = $buttons->new_button (-text => "Tare", -width=> 10, -com +mand => sub {tare_scale();}, -background => "red", -pady => 5, -padx +=> 3); $tarebut -> g_grid(-column =>1, -row => 0, -sticky => "E"); my $lblscale = $buttons->new_label (-text => "Scale"); $lblscale -> g_grid(-column => 0, -row => 1, -sticky => "w"); my $eread_scale = $buttons->new_entry (-width => 15, -textvariable => +\$read_scale); $eread_scale -> g_grid(-column => 1, -row => 1, -sticky => "w"); my $PORT = "COM1"; # port to watch my $ob = Win32::SerialPort->new ($PORT) || die "Can't Open $PORT: $!"; $ob->baudrate(1200) || die "failed setting baudrate"; $ob->parity("odd") || die "failed setting parity"; $ob->databits(7) || die "failed setting databits"; $ob->handshake("rts") || die "failed setting handshake"; $ob->stopbits(1) || die "failed setting stop bits";; $ob->write_settings || die "no settings"; sub read_scale{ $ob->transmit_char(0x1b); $ob->transmit_char(0x50); $ob->transmit_char(0x0d); $ob->transmit_char(0x0a); sleep .2; my $result = $ob->input; $read_scale = ($result); print "result = $result\n"; my $got_it = $ob->lookfor; } sub tare_scale{ $ob->transmit_char(0x1b); $ob->transmit_char(0x54); $ob->transmit_char(0x0d); $ob->transmit_char(0x0a); } sub clean_exit{ undef $ob; exit; } Tkx::MainLoop();
    $PORT = "COM1"; # port to watch $ob = Win32::SerialPort->new ($PORT) || die "Can't Open $PORT: $!"; $ob->baudrate(1200) || die "failed setting baudrate"; $ob->parity("odd") || die "failed setting parity"; $ob->databits(7) || die "failed setting databits"; $ob->handshake("rts") || die "failed setting handshake"; $ob->stopbits(1) || die "failed setting stop bits";; $ob->write_settings || die "no settings"; # Send a hex string to the port my $sendP = pack('C*', 0x1b, 0x50); # the print command my $sendT = pack('C*', 0x1b, 0x54); # the tare command my $pass=$ob->write($sendP); sleep 1; my $result = $ob->input; print "result = $result\n"; undef $ob;
Help with script recognizing variable in string
1 direct reply — Read more / Contribute
by TonyNY
on Jun 19, 2018 at 21:36
    Hi,

    I'm most likely not even asking this question correctly so let me try to explain as best I can. I'm running the following relevance query using curl and need for the $bfquery variable to recognize $bfcomputer as the value of the argument when I run the script. Sort of nesting a variable inside of a variable if you will.

    $bfquery='query?relevance=%28names%20of%20it%2C%20ip%20addresses%20of% +20it%2C%20root%20server%20of%20it%2C%20operating%20systems%20of%20it% +2C%20 last%20report%20time%20of%20it%2C%20agent%20versions%20of%20it%2C%20va +lues%20of%20results%20from%20%28BES%20Property%20%22_SupportGroup%22% +29%20of%20it%29%20of%20bes%20 computers%20whose%20%28%20name%20of%20it%20as%20lowercase%20starts%20w +ith%20%22$bfcomputer%22%29';
    tried putting {} around $bfcomputer but that did not help.

    Kind Regards,

    Tony

Matching patterns with or
2 direct replies — Read more / Contribute
by corfuitl
on Jun 19, 2018 at 12:06

    Dear Perlmonks

    Applying the following code

    while ($_ =~ /({\d+})/ || $_ =~ /({\w+&gt;)/ || $_ =~ /(&lt;\w+})/){ print "$1\n"; }

    to this text

    This is &lt;i} a test {i&gt; sentence &lt;i}

    I get

    {i&gt;    &lt;i}    &lt;i}

    Is there any way to get them according to their occurrence? So,

    &lt;i}  {i&gt;  &lt;i}

    Thanks

Module Ideas, Suggestions, and Requests
4 direct replies — Read more / Contribute
by oducs
on Jun 19, 2018 at 08:34

    I am looking for new and interesting ideas for Perl modules!

    The chosen modules will be uploaded to the new oducs CPAN: http://search.cpan.org/~oducs/

    If you have a module which you would like to abandon into my care, let's hear about it.

    Also, I have an interest in simultaneously developing Pure-Perl and XS versions.

    Appreciated, Charlie Root (perlmonks@oducs.org)
Benchmarks target in Makefile
3 direct replies — Read more / Contribute
by bliako
on Jun 19, 2018 at 07:50

    Dear Monks,

    I would like to add a target for running benchmarks on my code to the Makefile produced by ExtUtils::MakeMaker

    I already have a benhmarks.pl file which does everything and prints a report. I would like to have it executed whenever I do: make benchmarks . And only then because it is time consuming and should not be in tests.

    thanks,
Win32::OLE SaveAs Unicode
1 direct reply — Read more / Contribute
by Anonymous Monk
on Jun 19, 2018 at 07:39

    Monks,

    I need to use Win32::OLE to extract the text from MsWord. The best solution I could find to maintain a bit of formatting is to use the SaveAs function (I would prefer to read directly into a variable, but I can leave with it). The problem is I can NOT find how to set the parameters to save the file in Unicode (something you get asked by Word after clicking on SaveAs...). I've read all I could, but could not find any substitution/completion of "wdFormatTextLineBreaks" to achieve this goal. On Microsoft specification page, they speak about "wdFormatUnicodeText" with value "7". But I can't find how to specify it in my script (just replacing "wdFormatTextLineBreaks" with "wdFormatUnicodeText" does not produce any effect). Maybe some of you know the answer.

    #!/usr/bin/perl use strict; use warnings; use File::Spec::Functions qw( catfile ); use Cwd qw(cwd); use Win32::OLE; use Win32::OLE::Const 'Microsoft Word'; $Win32::OLE::Warn = 3; my $dir = cwd; my $word = get_word(); $word->{Visible} = 0; my $doc = $word->{Documents}->Open(catfile $dir, 'test.docx'); $doc->SaveAs( catfile($dir, 'test.txt'), wdFormatTextLineBreaks ); $doc->Close(0); sub get_word { my $word; eval { $word = Win32::OLE->GetActiveObject('Word.Application'); }; die "$@\n" if $@; unless(defined $word) { $word = Win32::OLE->new('Word.Application', sub { $_[0]->Quit +}) or die "Oops, cannot start Word: ", Win32::OLE->LastError, "\n"; } return $word; } __END__
Exact Regex for port Number
4 direct replies — Read more / Contribute
by theravadamonk
on Jun 19, 2018 at 03:15

    Hi, Monks, I am looking for an EXACT REGEX for a port number?

    a few e.g

    :42744

    :1024

    It DON'T want to MATCH my date Jun 19 08:48:50 where : is also present.

    I went to https://regex101.com/ and wrote a bit, It WILL catch : of DATE data too

    this catches BOTH

    :[0-9]+
    Can I have this?
    :[0-9]{4,5}

    Your efforts r welcome.

74HC165 serial register reading with perl
2 direct replies — Read more / Contribute
by rkrasowski
on Jun 18, 2018 at 14:55
    Hi Perl Monks, that may be the silly question. I am trying to read data from 74HC165 which is PISO serial register. How effective (fast) would be to read it using Perl? Any code examples? Thanks like always Robert
How can I replace the pattern in the 6 th field?
2 direct replies — Read more / Contribute
by theravadamonk
on Jun 18, 2018 at 11:23

    Hi Perl Monks,

    I have DATA like this

    __DATA__ Jun 12 09 mail (sender@sender.com) - (recip1@domain.com) 0.075 9387 Jun 12 10 mail (sender@sender.com) - (recip1@domain.com),(recip2@domai +n.com) -1.889 25623

    How can I replace the pattern ( and ) in the 6 th field?

    The OUTPUT I expect is

    __DATA__ Jun 12 09 mail (sender@sender.com) - recip1@domain.com 0.075 9387 Jun 12 10 mail (sender@sender.com) - recip1@domain.com,recip2@domain.c +om -1.889 25623

    the below code replaces all fields.

    $_ =~ s/\(|\)//g;

    Can I have something like this?

    $_ =~ s/\(|\)//$f[6]g;

    Your Ideas? Pls help me to slove this.


Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and monks are getting baked in the sun...

    How do I use this? | Other CB clients
    Other Users?
    Others studying the Monastery: (7)
    As of 2018-06-20 14:24 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Should cpanminus be part of the standard Perl release?



      Results (116 votes). Check out past polls.

      Notices?