Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
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
Perl -T vs Mime::Types
4 direct replies — Read more / Contribute
by roperl
on Sep 19, 2017 at 15:03
    What method is better to test if file is a plain ascii text file. I'm already checking MIME types of non-text file with File::Type.
    Should I check the text files with perl's -T like so:
    if(-T $file) { print "$file is an ascii text file \n"; } else { print "Not an ascii text file \n"; }
    Or check that it matches application/octet-stream MIME type like so:
    my $ft = File::Type->new(); my $type = $ft->mime_type($file); if ( $type eq "application/octet-stream" ) { do this.. } else { do that.. }
Splitting a file based on matched conditions
6 direct replies — Read more / Contribute
by skumar_pm
on Sep 19, 2017 at 04:59

    I want to split file contents to an outputfile by comparing real number data present in the last line? For example, the file contains of more 100K lines

    Start:/abc/def ..... End 1.2 Start:/xyz/uvw ..... End 2.8

    I want to print everylines from "Start" to "End" to OUTFILE1 if "End" contains values between 1-1.9; Otherwise print all the lines to OUTFILE2 if "End" contains values between 2-2.9. Likewise, mulitple output files have to be generated.

    code here

    foreach $lineIn (@file1_list) { $_ = $lineIn; if (/Start:/) { $pattern1 = 1; } elsif(/End\s/) { my @slackno = split /\s+/, $_; $pattern2 = 1; push (@buflines, $_); } if ($pattern1 =~ 1 and $pattern2 =~0) { push (@buflines, $_); } else { $pattern1 = 0; $pattern2 = 0; } } if ($slackno[3] >= 2.0 and $slackno[3] <= 2.9) { foreach ( @buflines ) { print FILE2 $_; } } close(FILE2);

    2017-09-20 Athanasius added code tags

[emacs] dual files mangling Perl and Lisp code?
5 direct replies — Read more / Contribute
by LanX
on Sep 19, 2017 at 04:15
    Hi

    is there a recommended way to mix Perl and eLisp code in one file without caring about escaping, such that it can be executed in both ways?

    Something like

    my $perl; #code ... __DATA__ (ELisp...)

    Just that emacs ignores the Perl part when executing the file?

    There are similar examples with bash and bat...

    update

    Just realising that ; is a comment symbol in lisp and a no op in Perl, this might be simplistic way to do it. ..

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Je suis Charlie!

Writing a file from foreach loop
2 direct replies — Read more / Contribute
by rahulruns
on Sep 19, 2017 at 01:38

    I have an pl file that reads an xml and create another pl file. File is created by looping through an array. Issue is it writes for first element of array but not for further elements. I understand that it is perl features that it opens a file only once but how do I get past this issue and be able to write a file through out loop Also let me know if you have any other tips and comment for my code

    use strict; use warnings; use diagnostics; use lib '/home/rahul/Documents/'; use script::filldataforlocator qw(clickfield send_keys_field); use script::readxmlcid qw(get_child_node_value); use script::getdata qw(connectdatabase); use XML::LibXML; my $module_used_file = $ARGV[1]; open(my $module_build_file_handle, '<', $module_used_file)or die "Coul +d not open file $module_used_file: $!"; my @module_file_lines = <$module_build_file_handle>; close $module_build_file_handle; my $dom = XML::LibXML->load_xml(location => $ARGV[0]); my $test_run_file_create = $dom->findvalue('//scenario/runname'); open(my $test_build_file_handle, '>', $test_run_file_create) or die "C +ould not open file '$test_run_file_create' $!"; foreach (@module_file_lines){ print $test_build_file_handle $_; } my @forms_required = ("createnewcid", "customerform"); my @child_node_values_fill; my $locatory_fields_id; my $locator_type; my $event_type; my $data_fill; my %hash_for_db_connect = ("companyname " => "contactnames", "contactn +ame" => "contactnames", "title" => "contactnames"); foreach my $config_forms (@forms_required) { @child_node_values_fill = get_child_node_value($config_forms); foreach (@child_node_values_fill) { ($locatory_fields_id, $locator_type, $event_type, $dat +a_fill) = split (/,/, $_); if (defined $locatory_fields_id && defined $locator_ty +pe && defined $event_type) { if ($event_type eq "click"){ print "My locator is $locatory_fields_id\n"; print $test_build_file_handle clickfield($loca +tory_fields_id, $locator_type)."\n"; print $test_build_file_handle "sleep(20)\;"."\ +n"; } elsif($event_type eq "send"){ if (defined $data_fill){ if (defined $hash_for_db_conne +ct{$data_fill}){ my $input_field_value += connectdatabase("$data_fill", "smartcidtest.$hash_for_db_connect{$d +ata_fill}"); print $test_build_file +_handle send_keys_field($locatory_fields_id, $locator_type, "$input_f +ield_value")."\n"; print $test_build_file +_handle "sleep(20)\;"."\n"; } } } } } } close $test_build_file_handle; chmod 0755, $test_run_file_create;
Is 'use vars' really obsolete?
7 direct replies — Read more / Contribute
by jnorden
on Sep 18, 2017 at 19:37
    The current documentation for 'vars' says: "...this pragma has been superseded by our declarations,..."

    This doesn't seem quite right to me. Consider the following case. Suppose a project is small enough that I want to keep it all in one file. But it is split into two packages, mostly to have separate namespaces for two different tasks. (Maybe one package prints a web form, the other one processes it's submissions.) Now say that I want to 'use strict'. If I declare the the variables with 'our', that defeats the namespace-separating purpose of using packages. Using 'my' would only work if each package was inside its own {block}, making the packages superfluous. Worse, there is no way for packages FOO and BAR to communicate via $FOO::this and $BAR::that if $this and $that are 'my' variables.

    I don't see an alternative to 'use vars' for this. Am I missing something?

Inline::C in a Perl module
2 direct replies — Read more / Contribute
by enemyofthestate
on Sep 18, 2017 at 14:33

    I am trying to use Inline::C in a perl module. The C code appears to compile fine (at least there is a .so file in the right place) but the module does not return a true value to the calling program and I cannot figure out how to make that work. I've tried putting the usual "1;" at various places in the code but it either chokes when compiling or tells me:

    "DLDtest.pm did not return a true value at bin/dldtest.fcgi line 11."

    Anyone know how to make this work?

    This is some stripped down code I am using to test with:

    dldtest.fcgi

    #!/usr/bin/perl use strict; use warnings; use File::Basename; use FindBin; use lib dirname($FindBin::Bin) . "/modules"; use DLDtest; my ($dlid,@dlfiles) = dld_initialize("lic_file", "123456", 5, "/path/t +o/data/files"); exit 0;

    DLDtest.pm

    package DLDtest; use strict; use warnings; use Exporter qw(import); use English; our @EXPORT = qw (dld_initialize); #------------------------------------------------ # initialize dld and open data files #------------------------------------------------ sub dld_initialize { my ($lic_file, $password, $num_files, $dl_format) = @_; my @files = (); # initalize the DLD library my $dlid = dl_DlInit(""); # set the license file and password unless (dl_DlSetLicense($dlid, $lic_file, $password)) { return (0,@files); } # open the DLD files for (my $cntr = 0; $cntr < $num_files; $cntr++) { my $path = sprintf($dl_format, $cntr + 1); my $fileid = dl_DlFileOpen($dlid, $path); $files[$cntr] = $fileid ? $fileid : 0; } return ($dlid,@files); } #------------------------------------------------ # C functions to interface with Pitney library #------------------------------------------------ use Inline (C => Config => DIRECTORY => '/var/www/addrez/Inline', INC => "-I/var/www/addrez/ext.att/include", LIBS => '-L/var/www/addrez/ext.att/lib -ldemolibMT'); use Inline "C"; Inline->init; __DATA__ __C__ #include "dl.h" /*----------------------------------------------- * Initialize the DLD librariy *---------------------------------------------*/ long dl_DlInit (SV* initPath) { return DlInit(SvPV (initPath, PL_na)); } /*----------------------------------------------- * associate a license file and password with dl *---------------------------------------------*/ int dl_DlSetLicense(long dl, char* licenseFile, long password) { return DlSetLicense(dl, licenseFile, password); } /*----------------------------------------------- * open a data file and return FileID *---------------------------------------------*/ long dl_DlFileOpen (long dl, char *path) { return DlFileOpen(dl, path); }
reading special parts of a JSON File
2 direct replies — Read more / Contribute
by Furkan
on Sep 18, 2017 at 05:14
    Hey Monks! I'm new here and I would like to ask you for help. So I've got a JSON File, may it be something like this:
    { "local": { "tomcat": { "general": { "catalina_home": "somewhere/tomcat/current", "install_dir": "somewhere/tomcat/8.5.20", "name": "Tomcat Web Application Server", "version": "1.8u131" } "instances" { "instance_name": { "catalina_base": "somewhere/tomcat_instances/instan +ce_name", "port" { "http": 18081, "https": 19081 }, "unix_group": "tmcuser", "unix_user": "tomcat1" }, "instance_name2": { "catalina_base": "somewhere/tomcat_instances/instan +ce_name2", "port" { "http": 18082, "https": 19082 }, "unix_group": "tmcuser", "unix_user": "tomcat2", } } } } }
    I want to read out certain information out of that JSON File and I already found out how to read informations which contains data (f.e. "catalina_base"), but I also would like to read out the instance names ("instance_name" and "instance_name2"). The way I read out the informations containing data is by for example:
    (...) my $data = decode_json($json); my $Catalina_Base = $data->{'local'}->{'tomcat'}->{'instances'}->{' +instance_name'}->{'catalina_base'}; (...)
    How am I able to read out the instance name? If I try
    (...) my $data = decode_json($json); my $Instance_Name = $data->{'local'}->{'tomcat'}->{'instances'}->{' +instance_name'}; (...)
    I get every single information instance_name contains like catalina_base, port etc. but I just want the name of the instance. Is there any way to do that? I would be really thankful if you could help me. Greetings Furkan
CPAN via Proxy and no auth
2 direct replies — Read more / Contribute
by chefchanyu
on Sep 18, 2017 at 00:06
    Hi any one know how to make the CPAN via Proxy but not auth required? i had config the proxy for CPAN but keep ask me to enter user and password. Please Help
Building a UDP Ethernet header
3 direct replies — Read more / Contribute
by TorNZZ
on Sep 17, 2017 at 18:10

    I find this code and it sends UDP packet and all information in is ok, But in Ethernet header layer i find that the source mac-address is like: fe:ff:ff:ff:ff:ff So i ask how can i control the source mac address? How can i make sub-function to return the ethernet layer and i control of it like other layers?

    #!/usr/bin/perl ###################################################################### +#### # Author: Lucas Thoresen + # # Attribution: cleen -> http://www.perlmonks.org/index.pl?node_id=1757 +6 # # Date: December 8, 2012 + # # Purpose: To demonstrate Perl UDP packet generation. + # # Hopefully someone will find this useful. :] + # ###################################################################### +#### use strict; use warnings; use Socket; # Source and destination IP/Hostname my $ip_src = (gethostbyname($ARGV[0]))[4]; my $ip_dst = (gethostbyname($ARGV[1]))[4]; # Check to see if all parameters are present if (!defined $ip_src or !defined $ip_dst) { exit "Usage: $0 <source ip> <destination ip>\n"; } # Setup the socket to be used 255 is IPPROTO_RAW) socket(RAW, AF_INET, SOCK_RAW, 255) or die $!; setsockopt(RAW, 0, 1, 1); main(); # Main program sub main { my $packet; # Add the layer 3 and 4 headers $packet = ip_header(); $packet .= udp_header(); # Add in a data section $packet .= payload(); # Fire! send_packet($packet); } # Builds an IP header (Layer 3) sub ip_header { my $ip_ver = 4; # IP Version 4 + (4 bits) my $ip_header_len = 5; # IP Header Length + (4 bits) my $ip_tos = 0; # Differentiated Servic +es (8 bits) my $ip_total_len = $ip_header_len + 20; # IP Header Length + Da +ta (16 bits) my $ip_frag_id = 0; # Identification Field + (16 bits) my $ip_frag_flag = '000'; # IP Frag Flags (R DF M +F) (3 bits) my $ip_frag_offset = '0000000000000'; # IP Fragment Offset + (13 bits) my $ip_ttl = 255; # IP TTL + (8 bits) my $ip_proto = 17; # IP Protocol + (8 bits) my $ip_checksum = 0; # IP Checksum + (16 bits) my $ip_header = pack( 'H2 H2 n n B16 h2 c n a4 a4', $ip_ver . $ip_header_len, $ip_tos, $ip_total_len, $ip_frag_id, $ip_frag_flag . $ip_frag_offset, $ip_ttl, $ip_proto, $ip_checksum, $ip_src, $ip_dst ); return $ip_header; } # Builds a UDP header (Layer 4) sub udp_header { my $udp_src_port = 60; # UDP Sort Port + (16 bits) my $udp_dst_port = 60; # UDP Dest Port + (16 btis) my $udp_len = 8 + length(payload()); # UDP Length + (16 bits) my $udp_checksum = 0; # UDP Checksum + (16 bits) my $udp_header = pack( 'n n n n', $udp_src_port, $udp_dst_port, $udp_len, $udp_checksum ); return $udp_header; } # Builds a data section sub payload { my $data = 'abcdefghijklmnopqrstuvwxyz hi'; # Pack the data in dynamically my $payload = pack( 'a' . length($data), $data ); return $payload; } # Send the packet sub send_packet { # @_ doesn't work, you need to use $_[0] as the param to the send +sub! send(RAW, $_[0], 0, pack('Sna4x8', AF_INET, 60, $ip_dst)); }
RFC: Math::Triangle (Perl 6)
3 direct replies — Read more / Contribute
by holli
on Sep 17, 2017 at 15:40
    So, I was toying around with Perl 6 lately. The following is a first iteration for a class to calculate all things triangle. I'd be happy about input about the code as I am new to Perl 6 and I am sure there is a lot to be improved. Also, when I post this thing (and the rest of its package), should I name the package Math::Geometry? Or better something less intrusive like Homework::Geometry?

    Edit: The site mangles up the unicode operators. &#9651; is a triangle, &#945; to &#947; are the greek letters alpha to gamma.


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 all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others pondering the Monastery: (1)
    As of 2017-09-23 02:59 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      During the recent solar eclipse, I:









      Results (270 votes). Check out past polls.

      Notices?