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
Unable to load the parser
1 direct reply — Read more / Contribute
by amitkumarj441
on Apr 26, 2017 at 16:28

    I have built a perl based application which can translate natural language to sql query and I'm testing it on Windows 7 using but here after running my perl script "sq-hal.pl"(code is given below) it unable to load the parser. Given below is the encountered error :

    Establishing connection to DBI:mysql:student ... Creating the parser... Reading table names... Table names: XS_Tk__Callback_Call error:Undefined subroutine &main::column_names_to_parser_st r called at parser.pl line 38. Tk::Error: Undefined subroutine &main::column_names_to_parser_str called at pars er.pl line 38. Parse::RecDescent::BEGIN at grammar_func.pl line 52 main::load_parser at parser.pl line 38 main::load_data at splash.pl line 81 Tk::After::once at C:/Dwimperl/perl/site/lib/Tk/After.pm line 90 [once,[{},after#27,10,once,\&main::load_data]] ("after" script)

    Given below are the scripts, Can anyone here help me in resolving this error?

    # sq-hal.pl use strict; # Required Modules use Tk; use Tk::Table; use Tk::Text; use Tk::Photo; use Tk::Balloon; # Global variables use vars qw ( $user_input ); # English query typed by the user use vars qw ( $win_sq_hal ); # the main window for SQGNL use vars qw ( $parser ); # SQGNL parser which contains all th +e grammar use vars qw ( $results ); # results of SQGNL parsing of the En +glish query use vars qw ( $save_parser ); # whether parser need to be required + at the end (0 or 1) use vars qw ( @learn_strs ); # temporary hold new grammar to be l +earned use vars qw ( $results_table ); # table to display database records use vars qw ( $status_text ); # status bar text to be displayed use vars qw ( $default_status_text ); # default status bar text use vars qw ( $txt_output ); # text area where the output of SQGN +L is displayed # SQGNL configuration variables use vars qw ( $user ); # user name to login to the database use vars qw ( $passwd ); # password for the database login use vars qw ( $db_source ); # database source use vars qw ( $db_type ); # type of database use vars qw ( $learn_enabled ); # enable/disable learning grammar (0 + - disable, 1 - enable) use vars qw ( $rows_displayed ); # number of rows from the results qu +ery to be displayed to the user use vars qw ( $config_file_found ); # status of the configuration file + (0 or 1) # Modular level variables my $txt_input; # text area for users to type the query # Combine all the required files and # load the subroutines from various files do "configure.pl"; # configuration window definitions load_config(); # load the configuration data from a file do "parser.pl"; # SQ-HAL parser definitions do "splash.pl"; # splash sceen definitions do "database.pl"; # definitions for various database functionalit +ies # if the configuration file is not found then # (either due to first-time running or confgureation file got deleted) # show the SQGNL confiugration window to get required info if ($config_file_found == 0) { show_config(); } do "login.pl"; # get database login password save_config(); # user name might have changed when login scree +n is # called. So save the new configuration data do "db_structure.pl"; # window definition to show/get database s +tructure do "create_sql.pl"; # window definition to create SQL statemen +ts manually do "learning.pl"; # window definition to display new grammar + to be learnt do "relationships.pl"; # window definition to display/get table r +elationships ### Show the splash screen while loading the parser ### ### as the parser may take some time to load ### show_splash(); ### Create and show the main SQGNL window ### create_main_window(); # Display the spalsh screen and load parser grammar in the background sub create_main_window { $win_sq_hal = MainWindow->new; # create the main SQGNL window $win_sq_hal->appname("SQGNL"); $win_sq_hal->title("SQGNL: The Natural Language to SQL Translator" +); ### maximize and position the SQGNL main window ### my $w = $win_sq_hal->screenwidth()-10; # window width = screen +width my $h = $win_sq_hal->screenheight()-100; # window height = screen + height $win_sq_hal->geometry("${w}x${h}+0+20"); ### define and place window controls ### my $tooltip = $win_sq_hal->Balloon( -statusbar => $status_text ); my $win_sq_hal1 = $win_sq_hal->Frame( -relief => 'flat', -borderwidth => 10) ->pack( -ipadx => 10, -fill => 'both', -expand => 1); $win_sq_hal1->Label( -text => "Type your question below:", -anchor => "sw") ->pack( -fill => "x"); ### user input text area ----------------------------------------- +------ $txt_input = $win_sq_hal1->Scrolled( 'Text', -scrollbars => 'e', -height => 2, -wrap => "word") ->pack( -side => "top", -fill => "x", -expand => 0); $tooltip->attach($txt_input, -msg => "Type your English query here and then pr +ess Tranlate button."); my $fra_buttons1 = $win_sq_hal1->Frame->pack( -side => 'top', -fill => 'x', -expand => 0 ); ### button to activate translate the English query --------------- +------ my $cmd_translate = $fra_buttons1->Button( -text => "Translate th +e query to SQL", -command => \&parse_inpu +t) ->pack( -side => "left", -ipadx => 10, -anchor => "ne"); $tooltip->attach($cmd_translate, -msg => "Translate the English query into SQL."); ### button to clear the content in the query text area ----------- +------ my $cmd_clear = $fra_buttons1->Button( -text => "Clear", -command => sub { ### delete everything i +n the text area ### $txt_input->delete("1.0 +", "end"); } ) ->pack( -side => "left", -ipadx => 10, -padx => 10, -anchor => "ne"); $tooltip->attach($cmd_clear, -msg => "Clear the text in the English query area +."); ### button to bring up the create_sql window --------------------- +------ my $cmd_create_sql = $fra_buttons1->Button( -text => "Create your +own SQL", -command => \&show_create +_sql) ->pack( -side => "right", -ipadx => 10, -anchor => "ne"); $tooltip->attach($cmd_create_sql, -msg => "Bring up the window where you can create + your own SQL statements with ease."); my $fra_output = $win_sq_hal1->Frame->pack( -side => 'top', -fill => 'x', -expand => 0 ); ### text area to display output results -------------------------- +------ $txt_output = $fra_output->Scrolled( 'Text', -scrollbars => 'e', -height => 3, -wrap => "word") ->pack( -side => "left", -anchor => "nw", -fill => "x", -expand => 1); $tooltip->attach($txt_output, -msg => "Translated SQL statments are displayed h +ere. You may can modify this and press execute button\n to see the results +of the SQL statment"); ### button to execute SQL in the txt_output area ----------------- +------ my $cmd_exec = $fra_output->Button( -text => "Execute SQL", -command => sub { ### copy the content of th +e txt_output ### ### (SQL statement) to the + varaiable $results ### $results = $txt_output->ge +t("1.0", "end"); ### execute SQL and show t +he results ### if ( $results ne "") { show_data(); } } ) ->pack( -side => "right", -ipadx => 10, -pady => 10, -anchor => "ne"); $tooltip->attach($cmd_exec, -msg => "Execute the SQL statment and display the + results."); ### $status_text bar text area ----------------------------------- +------ $default_status_text = "SQ-HAL: The Natural Language to SQL Transl +ator"; $status_text = $default_status_text; $win_sq_hal->Label( -textvariable => \$status_text, -relief => "sunken", -anchor => "nw", -borderwidth => 2) ->pack( -side => "top", -fill => "x", -padx => 10, -expand => 0); my $fra_buttons2 = $win_sq_hal1->Frame ->pack( -side => "bottom"); ### button to bring up the database structure window ------------- +------ my $cmd_database = $fra_buttons2->Button( -text => "Database", -underline => 1, -command => \&show_databa +se) ->pack( -fill => "x", -ipadx => 20, -padx => 10, -pady => 5, -side => "left", -expand => 0); $tooltip->attach($cmd_database, -msg => "Display the current database structure." +); ### button to bring up the configuration window ------------------ +------ my $cmd_config = $fra_buttons2->Button( -text => "Configure", -underline => 2, -command => \&show_config) ->pack( -fill => "x", -side => "left", -ipadx => 20, -padx => 10, -pady => 5, -expand => 0); $tooltip->attach($cmd_config, -msg => "Configure SQ-HAL."); ### button to exit to the system --------------------------------- +------ my $cmd_exit = $fra_buttons2->Button( -text => "Exit", -underline => 1, -command => \&exit_sq_hal ) ->pack( -fill => "x", -ipadx => 40, -padx => 10, -pady => 5, -side => "left"); $tooltip->attach($cmd_exit, -msg => "End SQ-HAL and Exit to the system."); ### table to display results from the SQL statements ------------- +------ $results_table = $win_sq_hal1->Table( -rows => 1, -columns => 1, -scrollbars => "se", -relief => "groove", -borderwidth => 2, -fixedrows => 1) ->pack( -side => "top", -fill => "both", -expand => 1); $tooltip->attach($results_table, -msg => "Display data retrieved from the database +."); ### exit the program when destroying this main window ############ +###### $win_sq_hal->bind("<Destroy>", \&exit_sq_hal); ### set the focus to the query entering area ### $txt_input->focus; ### display this window and start handling events ### MainLoop; } # parse user input and show results sub parse_input { ### update the statusbar text ### $status_text = "Translating the English statement to a SQL stateme +nt..."; $win_sq_hal->update(); ### the input and output files and commented lines below ### ### are used for testing purposes only ### #my $inputFile = "data.txt"; #my $outputFile = "output.txt"; #open(DATA, "< $inputFile") || die $!; #open(OUT, "> $outputFile") || die $!; #while (<DATA>) #{ # if (!/^#/ && !/^[\s]*\n/) # Ignore commented lines and +empty lines # { # print "> "; # sleep 1; # print; ### copy the English query to the variable $user_input ### $user_input = $txt_input->get("1.0", "end"); ### remove special characters from the input ### $user_input =~ s/[:.'?!]//g; ### translate the user query to SQL ### eval{ $results = $parser->translate("\L$user_input"); }; ### clear the current content of the output area and insert new tr +anslated SQL ### $txt_output->delete("1.0", "end"); $txt_output->insert("end", $results); $_ = $results; ### if the first word of the results is "SELECT" then it is an + ### ### SQL statement. Otherwise it is and untranslated error message + ### if (/^SELECT/) { ### display the SQL statement in bule colour ### $txt_output->configure( -foreground => "blue" ); ### execute SQL and show the results ### show_data(); ### if there are anything to be leart, then display the learni +ng window ### if ($#learn_strs >= 0) { show_learn(); } } else ### English query not translated into SQL ### { ### if the learning is enabled, then add this English query ## +# ### to the query list that to be learnt ## +# if ($learn_enabled) { $learn_strs[++$#learn_strs] = "\L$user_input"; } ### display the error message in red ### $txt_output->configure( -foreground => "red" ); } ### update window controls ### $win_sq_hal->update(); ### save the results in the outupt file ### #print OUT $user_input, $results, "\n"; # } #} ### close all the open files ### #close(DATA); #close(OUT); ### update the statusbar with default text ### $status_text = $default_status_text; $win_sq_hal->update(); } # retrieve data from the database and display on to the screen sub show_data() { ### change the mouse icon to be busy icon ### $win_sq_hal->Busy; ### update statusbar text ### $status_text = "Retrieving data from the database..."; $txt_output->configure( -foreground => "blue" ); $win_sq_hal->update(); ### execute the SQL results ### ### this will update the results table as well ### execute_sql( $results ); ### update status bar text back to default ### $status_text = $default_status_text; ### change the mouse icon back to normal ### $win_sq_hal->Unbusy; } ### used as a flag to determine the exit function is called once ### ### multiple calls to the function is posible if the user press ### ### exit button as well as destorying the window calls the func. ### my $already_exited = 0; # exit SQGNL by disconnecting from the database and saving the parser sub exit_sq_hal { ### do not repeat this subroutine twice ### if ($already_exited) { return } $already_exited = 1; ### change the mouse icon to be busy icon ### $win_sq_hal->Busy; ### disconnect the current database connection ### disconnect_from_db(); ### if required, save the parser to a file ### if ($save_parser) { ### update statusbar text $status_text = "Saving the parser to a file. Please wait..."; $win_sq_hal->update; save_parser(); } ### save database structure to a file ### #save_db_info(); ### exit to the system ### exit; }
    # parser.pl use strict; # Global variables use vars qw( %table_columns ); use vars qw( %table_relationships ); # Modular level variables ### Following variables used to test this parser only ### my $dataFile = "data1.txt"; ### Input Data file (for testing) + ### my $outputFile = "output.txt"; ### Output results file (for testin +g) ### my $debug_on = 0; ### Enable testing of this parser + ### my $trace_on = 0; ### Enable tracing the parser outpu +t ### my $grammar; ### SQGNL parser grammar + ### my $parser_file; ### name of the file which contains + parser object ### # combine table names into parser accepted string sub load_parser { $parser_file = "sq_hal_${db_type}_${db_source}_${user}"; ### replace invalid names in the file name ### $parser_file =~ s/[\\\/:*?<>|]//g; ### if parser file not found then load grammar ### if (!eval{require "${parser_file}.pm"}) { print "Creating the parser...\n"; ### Create the grammar ### $grammar = do "grammar.pl" or warn "Bad Grammar!"; ### Replace table_names ### my $tables_str = table_names_to_parser_str(); $grammar =~ s/TABLES/$tables_str/; ### Replace column names ### my $columns_str = column_names_to_parser_str(); $grammar =~ s/FIELDS/$columns_str/; } else { print "Loading the parser from the file '${parser_file}.pm'... +\n"; do "grammar_func.pl"; } ### initialize variables such as database structure, etc. ### initialize_vars(); use Parse::RecDescent; ## Enable tracing of the parser ### if ($trace_on) { $RD_TRACE = 1; } ### Load the parser from the file or ### ### create the parser if the file is not available ### $parser = eval{require "${parser_file}.pm"} ? $parser_file->new() : Parse::RecDescent->new($grammar) or warn "Bad Parser!"; ### if the parser file is not found, then the parser need to be sa +ved ### if (!eval{require "${parser_file}.pm"}) { $save_parser = 1; } ### if testing this parser only then do the following code ### if ($debug_on) { ### Open the input data file open(DATA, "< $dataFile") || die $!; open(OUT, "> $outputFile") || die $!; $| = 1; ### Parse each line of data ### while (<DATA>) { if (!/^#/ && !/^[\s]*\n/) ### Ignore commented or empty + lines ### { print "> "; #sleep 1; print; ### Translate the grammar ### my $SQL = $parser->translate("\L$_"); ### Print the translated output to the screen and outp +ut file ### print "$_$SQL\n"; print OUT "> $_$SQL\n"; } else { print OUT "$_"; } } ### Close files ## close(DATA); close(OUT); ### Exit to the system ### exit; } } # save the parser to a file sub save_parser() { print "Saving the parser to the file '${parser_file}.pm'..."; ### if exist, then delete the parser file ### if (eval{require "${parser_file}.pm"}) { eval { unlink "${parser_file}.pm"; }; } ### save the parser to file ### eval { $parser->Save($parser_file); }; ### do not need to save the parser in the near future again ### $save_parser = 0; } # learn new rule by the parser sub extend_parser { my ($rule, $str) = ($_[0], $_[1]); ### parser rule and the new le +arn string ### my $grammar = qq{ $rule : $str }; ### new grammar to be learn ## +# $parser->Extend($grammar); ### extend the parser grammar +### #$save_parser = 1; ### parser has been changed and therefore nee +d to save ### ### print the newly learn grammar ### print "Learn grammar:\n$grammar\n"; } # initialize table relationships and table-column relationships sub initialize_vars { @table_columns{get_table_names()} = (); foreach my $table (keys(%table_columns)) { my %tmp; @tmp{get_column_names($table)} = (); foreach (keys(%tmp)) { $tmp{$_} = "1"; } $table_columns{$table} = { %tmp }; } ### load the table relationships from the file ### if (open(DB, "${parser_file}.db")) { ### read each of the table relationship ### while (<DB>) { chomp($_); next unless s/^(.*?):\s*//; my $tbl1 = qq{$1}; for my $field ( split /;/ ) { my ($tbl2, $val) = split(",", $field); $table_relationships{ qq{$tbl1} }{ qq{$tbl2} } = qq{$v +al}; } } close(DB); ### close the file ### } } # combine table names into parser accepted string sub save_db_info() { open(DB, "> ${parser_file}.db"); ### save each table relationship to a file foreach my $tbl1 (keys(%table_relationships)) { print DB "$tbl1:"; foreach (keys(%{$table_relationships{$tbl1}})) { print DB "$_,", $table_relationships{$tbl1}{$_},";" ; } print DB "\n"; } close(DB); ### close the file ### } # combine table names into parser accepted string sub table_names_to_parser_str() { print "Reading table names...\n"; ### Get table names for the current database ### %table_columns = (); @table_columns{get_table_names()} = (); print " Table names: ", join(", ", keys(%table_columns)), "\n\n +"; ### Create the parser recognised string ### my $tables_str = ""; foreach my $table ( keys(%table_columns) ) { ### table words need to be lower case ### my $table_words = "\L${table}?"; $tables_str .= "/${table_words}/{'${table}'}|"; } chop($tables_str); ### Remove the last '|' character ### return $tables_str; } # combine all table columns into parser accepted string sub column_names_to_parser_str() { use Lingua::EN::Inflect ':ALL'; ### read column names for each table ### my $columns_str = ""; foreach ( keys(%table_columns) ) { if ( $_ ) { print "Read column names for '$_'...\n"; my $current_table = $_; ### Get the column names for the given table ### my @columns = get_column_names($_); print " Column names: ", join(", ", @columns), "\n\n"; ### Create parser recognised string ### foreach my $column (@columns) { ### column words need to be lower case ### my $column_words = "\L" . PL_N($column) . "|$column"; $columns_str .= "/${column_words}/{'${column}'}|"; } } } chop($columns_str); ### Remove the last "|" character ### return $columns_str; } 1; ### so the 'do' command succeeds ###
    # splash.pl use strict; # Modular level variables use vars qw( $win_splash ); # window handle for this splash scree +n my $PARSER_FILE = "parser.pl"; # name of the parser file my $splash_shown = 0; # splash screen is already shown or n +ot my $splash_info; # message to be displayed on the spla +sh screen # Display the spalsh screen and load parser grammar in the background sub show_splash { ### do not show the splash screen if already shown ### ### we do not want to load the grammar twice ### if ($splash_shown == 1) { return 0; } $splash_shown = 1; ### splash screen has been shown ### ### create splash screen ### $win_splash = MainWindow->new(); ### do no show the title bar for the splash screen ### $win_splash->overrideredirect(1); $win_splash->configure( -background => "white"); $win_splash->configure( -borderwidth => 1); ### center this window ### my $h = 270; ### window height ### my $w = 360; ### window width ### my $x = int(($win_splash->screenwidth()-$w)/2); ### x positi +on ### my $y = int(($win_splash->screenheight()-100-$h)/2); ### y positi +on ### $win_splash->geometry("${w}x${h}+${x}+${y}"); ### create window controls ### my $img_sq_hal = $win_splash->Photo( -file => 'splash.gif'); ### SQGNL image ### $win_splash->Label( -borderwidth => 0, -image => $img_sq_hal )->pack; ### display area for splash screen messages ### $win_splash->Label( -textvariable => \$splash_info, -background => "white") ->pack( -fill => "x", -side => "top"); ### Exit button - to exit to the system ### $win_splash->Button( -text => " Exit ", -background => "white", -borderwidth => 0, -command => sub { exit }) ->pack( -fill => "x", -side => "top"); ### show spalsh screen ### $win_splash->update(); $win_splash->raise(); # start loading the parser immediately after displaying the splash + screen ### $win_splash->after(10, \&load_data); MainLoop; } # Load initial data and the parser at startup sub load_data { ### connect to the database ### $splash_info = 'Connecting to the database...'; $win_splash->update(); ### if unsuccessful database connection, then exit the program ### if (! connect_to_db($db_type, $db_source, $user, $passwd )) { exit; } ### load SQGNL parser ### $splash_info = 'Loading SQ-HAL parser...'; $win_splash->update(); load_parser(); ### Destroy the splash screen ### $win_splash->destroy(); } 1; # so the 'do' command succeeds
Randomly reassign hash keys
6 direct replies — Read more / Contribute
by cormanaz
on Apr 26, 2017 at 12:47
    Good day bros. I would like to create a hash, then randomly reassign the keys (to support a randomization test). I know I can get a shuffled list of keys with
    use List::Util qw(shuffle); ... foreach my $k (shuffle keys %foo) { ... }
    but accessing that would leave the keys associated with the same values. I want to randomly reassign the keys to different values already in the hash. So if the original was
    %hash = ( "a" => 1, "b" => 2, "c" => 3, "d" => 4 };
    I could end up with
    %hash = ( "c" => 1, "d" => 2, "a" => 3, "b" => 4 };

    I can imagine how to do that in an inelegant way, but was wondering if there is an elegant way.

Views on reinitializing Log4perl
1 direct reply — Read more / Contribute
by #perl_noob
on Apr 26, 2017 at 10:11

    Dear monks,
    I am trying to re initialize log4perl from a user given path which overrides the default configuration. Is this the right way to go about it since using only init() also works? Since both the approaches work, in which cases will reset() help? It is mentioned that reset() rests all the loggers to their initial state.

    sub method { ... Log::Log4perl->reset(); Log::Log4perl->init($user_path); }
    Looking forward to your views. Thank You.

Malformed JSON Error Piwigo
1 direct reply — Read more / Contribute
by kiteboywales
on Apr 26, 2017 at 09:43

    Hi all - I looking for advise regarding the following error

     malformed JSON string, neither array, object, number, string or atom, at character offset 0 (before "<br />\n<b>Warning</...") at /usr/share/perl5/JSON.pm line 171

    Hope you dont mind asking - I get this error when uploading to something called PIWIGO. An online image gallery. The perl script itself is available here http://piwigo.org/ext/extension_view.php?eid=606

    While images do upload fine I get the above error and then the uploading stops. If I run the script again it can be seen that the image it seemed to fail on did upload and then it moves onto the nexxt image and then again the error pops up again.

    If someone has any ideas that would be great....thanks for any advice

looping through a hash and looking up values from another hash
5 direct replies — Read more / Contribute
by pearllearner315
on Apr 25, 2017 at 22:43
    Hello Monks, I have a hash with numbers as the keys and an array of elements as the values. I also have another hash with the numbers as the keys (these numbers exist in the first hash but numbers in first hash may not exist in second hash) and a number count as the values.
    %hash1 = ( 1=> ["You", "Me", "Him", "Her"], 2 => ["You", "Me", "Him", + "Her"], 3 => ["You", "Me", "Him", "Her"], and so on). %hash2 = ( 1 => 3, 51 => 0, 32 => 1, and so on)

    I need to loop through hash1, print out its values and also look up the value from the second hash that corresponds to the same key in the first hash and print that value. For example:

    If one of the keys from hash1 was 3 and if 3 existed in hash2, you would print the value of 3 from hash1 and the value of 3 in hash2 on the same line.

    this is what I have been doing:
    foreach my $keys (keys %hash1){ if (defined $hash2{$keys}){ print @{ $hash1{$keys} }, "\t", $hash2{$keys}, "\n";

    and it hasn't been printing anything. I hope to get:

    You Me Him Her 3

    as an example output for the first line

    what is wrong with my loop? any help would be great. thanks a lot guys!
Replacing an entire line if a substring is found
3 direct replies — Read more / Contribute
by victorz22
on Apr 25, 2017 at 22:09

    Hello Monks, I am trying to create a function that will replace an entire line in a scalar variable if a certain sub string is found. The variable contains a bunch of paths to different files and what I want to do is replace the entire line if that sub string is found. Thank you monks for your endless wisdom!

    The input data looks kinda like this ___DATA___ path/to/some/file path/to/some/other/file path/to/SUBTSTRING/file #replace entire line if SUBSTRING is found path/to/file
    sub scanForSubstringReplaceLine{ my($inputText, $subStringToScan, $lineReplacement) = @_; my $replacedText; $inputText =~ s/$subStringToScan/$lineReplacement/g; $replacedText = $inputText; return $replacedText; }
"executable suffixes" for -x on win32 (perlport)
3 direct replies — Read more / Contribute
by pryrt
on Apr 25, 2017 at 17:27

    Regarding the executable-test -x, perlport says:

    -x (or -X) determine if a file ends in one of the executable suffixes. -S is meaningless. (Win32)

    Where are the "executable suffixes" defined for Win32 perl (strawberry, in my case)? If anything, I would have expected $ENV{PATHEXT}, because that's the closest related idea to "executable" on windows (or possibly the assoc and ftype and their underlying registry entries -- though that's more complicated). However, I've got ".pl" in my PATHEXT variable and properly associated in the registry, but -x "$0" results in a false value (undef). I also tried with a .js file, which is in the Windows-default PATHEXT, but it shows up as non-executable as well. I've experimentally found that .com, .exe, .bat, and .cmd all show up as executable... but none of the others in the default PATHEXT=.COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC

    --

    context: after reading Re^2: how do i run a shell command without waiting for the output, I looked at Proc::Background, and saw that commands were "checked by appending `.exe' to the name in case the name was passed without the `.exe' suffix". Since ".exe" isn't the only extension dropped on Win32 (PATHEXT defines the extension-omission properties for Win32, and .bat is frequently untyped as well), I wanted to suggest a bugfix to allow any extension from PATHEXT: change the hardcoded push(@extensions, '.exe'); to push @extensions, split(/;/, $ENV{PATHEXT} || '.exe');. However, while testing my change against various extensions (explicit or omitted-but-implied), I found that Proc::Background wasn't getting as far as using the @extensions array, since -x was failing. I found the quoted perlport description that Win32 -x has a list of extensions, but I haven't found the official documentation for what that list is (and really, if there's any hardcoded list embedded in the perl ports to Win32, I disagree with them on the same grounds that I disagree with Proc::Background)

    #!/usr/bin/env perl use warnings; use strict; use Proc::Background; print "$0 => ", (-x $0 || 0), $/; foreach ( qw(./com-hello.com ./com-hello ./c-hello.exe ./c-hello ./bat +-hello.bat ./bat-hello ./cmd-hello.cmd ./cmd-hello ./js-hello.js ./js +-hello C:/path-to/cpan-bugs/proc-bg/js-hello.js) ) { local $\ = $/; local $, = "\t"; print STDERR $_; my $p = Proc::Background->new($_); if(!defined $p) { print STDERR $_, "didn't run"; next; } print STDERR '-x: ', ( (-x $_) || 0); print STDERR 'pid: ', $p->pid; print STDERR 'alive: ', $p->alive; print STDERR 'wait: ', $p->wait; print STDERR 'start: ', $p->start_time; print STDERR 'end: ', $p->end_time; print STDERR ''; } foreach my $ext (split /;/, $ENV{PATHEXT}) { local $\ = $/; local $, = "\t"; open my $fh, '>', "x$ext" or die "x$ext $!"; close $fh; print STDERR "x$ext", ( (-x "x$ext") || 0); unlink $fh; } __END__
    C:\path-to\cpan-bugs\proc-bg\hello-pathext.pl => 0 ./com-hello.com -x: 1 pid: 7164 alive: 1 Hello, world wait: 0 start: 1493154171 end: 1493154171 ./com-hello -x: 0 pid: 3488 alive: 1 Hello, world wait: 0 start: 1493154171 end: 1493154171 ./c-hello.exe -x: 1 pid: 3576 alive: 1 Hello, world wait: 0 start: 1493154171 end: 1493154171 ./c-hello -x: 0 pid: 5312 alive: 1 Hello, world wait: 0 start: 1493154171 end: 1493154171 ./bat-hello.bat -x: 1 pid: 4816 alive: 1 hello world wait: 0 start: 1493154171 end: 1493154171 ./bat-hello -x: 0 pid: 7972 alive: 1 hello world wait: 0 start: 1493154171 end: 1493154171 ./cmd-hello.cmd -x: 1 pid: 668 alive: 1 hello world wait: 0 start: 1493154171 end: 1493154171 ./cmd-hello -x: 0 pid: 6692 alive: 1 hello world wait: 0 start: 1493154171 end: 1493154171 ./js-hello.js C:\path-to\cpan-bugs\proc-bg\hello-pathext.pl: cannot find absolute lo +cation of ./js-hello.js ./js-hello.js didn't run ./js-hello C:\path-to\cpan-bugs\proc-bg\hello-pathext.pl: cannot find absolute lo +cation of ./js-hello ./js-hello didn't run C:/path-to/cpan-bugs/proc-bg/js-hello.js looking for absolute: C:/path-to/cpan-bugs/proc-bg/js-hello.js C:\path-to\cpan-bugs\proc-bg\hello-pathext.pl: no executable program l +ocated at C:/path-to/cpan-bugs/proc-bg/js-hello.js C:/path-to/cpan-bugs/proc-bg/js-hello.js didn't run x.com 1 x.exe 1 x.bat 1 x.cmd 1 x.vbs 0 x.vbe 0 x.js 0 x.jse 0 x.wsf 0 x.wsh 0 x.msc 0 x.pl 0 x.COM 1 x.EXE 1 x.BAT 1 x.CMD 1 x.VBS 0 x.VBE 0 x.JS 0 x.JSE 0 x.WSF 0 x.WSH 0 x.MSC 0 C:\path-to\cpan-bugs\proc-bg\>echo %pathext% .com;.exe;.bat;.cmd;.vbs;.vbe;.js;.jse;.wsf;.wsh;.msc;.pl;.COM;.EXE;.B +AT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC
using an array in place of a file when calling a hash
3 direct replies — Read more / Contribute
by bigip2000
on Apr 25, 2017 at 14:41

    I have this part of a script that calls a hash to apply to listoffiles. What it does it take the file mon2a and read the input and use the hash to organize it into a file that goes into /tmp/host. The file looks like this: CORP-INV-STAGE-NDM.txt It works just fine. I get a file that has /vol/volname,jobid in it when I cat CORP-INV-STAGE-NDM.txt. The problem is, I am trying to figure out how to use an array instead of a file like /tmp/mon2a. I need to know the format of how I should write the script so that it would use an array as input. At this point, it works only if I use the file. I've tried a foreach with an array but that doesn't seem to work. I do not need an answer that would make it run properly right away just a suggestion on how to get rid of

    open my $fh1, '<', "/tmp/host/mon2a" or die "unable to open file 'fil +e' for reading : $!";

    And the syntax of how to replace it with an array that contains the same information.

    my @list = (@lines); foreach (@lines) { my @fields = split /,/; if ( $fields[2] eq '1' || $fields[2] eq '0' ) { #@arr1 = do {"@fields[4]\n"}; push @list, $fields[4]; @list =uniq @list; print "$_\n" for @list; @listx = "$_\n" for @list; print "LETING US SEE @listx"; } } @listx; my %ndmhash; my @listoffiles = ("CORP-INV-STAGE-NDM"); for (@listoffiles) { { my $file = "/tmp/host/" . $_ . '.txt'; open(my $fh, '>', $file) or die "Cannot open file '$file' for writing: +$!"; my $name2 = $file; #$name2 =~ s/\CORP//g; #$name2 =~ s/*CORP-/ /g; $name2 =~ s/'$//; rename($file, $name2); $ndmhash{$_} = $fh; } } my $pattern = join '|', @listoffiles; $pattern = qr/$pattern/; open my $fh1, '<', "/tmp/host/mon2a" or die "unable to op +en file 'file' for reading : $!"; while (<$fh1>) { chomp; my @fields = split(',', $_); local $" = ','; if (($fields[2] eq '1' || $fields[2] eq '0') && /$pattern/) { print { $ndmhash{$fields[4]} } $fields[0], ',' +, $fields[32], ',', $fields[6], "\n" if /MONTHLY/ && !/,-,/ && !/SM3/ && !/FISH +/; print { $ndmhash{$fields[4]} } $fields[0], ',' +, $fields[34], ',', $fields[6], "\n" if /MONTHLY/ && !/,-,/ && /BASKET/; print { $ndmhash{$fields[4]} } $fields[0], ',' +, $fields[35], ',', $fields[6], "\n" if /MONTHLY/ && !/,-,/ && /FORM/; } } { close $ndmhash{$_} or die "Cannot close file '$_': $!"; }
Re-dimensioning an HTML table with Perl ?
11 direct replies — Read more / Contribute
by TheDonald
on Apr 25, 2017 at 13:08
    I'm staring down the abyss of something that I would rather not do manually. So it occurred to me that Perl is probably just the sort of thing for such a random requirement. What I need to do is "re-dimension" (what is the correct word ?) an HTML table. The table is currently 5x12, and I want to turn it into, say, 7x9. The thought of lifting and shifting dozens of cells by hand is filling me with dread ! I've no ideas where to start in terms of automating this, let alone how to code it (I've only recently joined the long road to Perl wisdom !).
DBI output into browser using CGI
6 direct replies — Read more / Contribute
by billycote
on Apr 25, 2017 at 10:53

    Hi folks. I have a little bit of code that takes in a couple of arguments and hooks up to a database using DBI. I want it to display back to a web page using CGI methods. It works great on the command line. If I copy the data back into an HTML page the browser looks exactly like I want it to. However.... when I try to pull it up directly from the browser the browser never gets beyond writing the header information. So my question is how can I make the browser wait until the whole HTML is there before trying to display it.

    Here's the pertinent parts of my code.

    #!/usr/bin/perl #use strict; use CGI; use DBI; use HTML::Template; $| = 1; open (STDERR,">/apps2/apache/cgi-bin/errorLog.txt"); my $q = CGI->new; my $sth; my $env; my $database; my $host; my $port; my $user; my $pw; print $q->header(-nph=>1); my $style = get_style(); print $q->start_html( -title => "XREF", -style => {-code => $style}, ); my $fields = "*"; my $symbol_in = $q->param('symbol'); my $site = $q->param('site'); print $q->h1 ("ACTIV INSTRUMENT TABLE DATA"); my $fields = "*"; #my @fields_in = $q->param('fields'); chomp $symbol_in; chomp $site; chomp $symbol_in; chomp $site; $symbol_in =~ s/\s//; foreach (@fields_in){ $_ =~ s/\s//; #if ($_ eq $type){ #next; #}else{ #$fields = join(',',$fields,split); #} $fields = join(',',$fields,split); } my $symbol = join('\',\'',split(/,/,$symbol_in)); &getConfig; my $dbh = DBI->connect("dbi:Oracle:sid=$database;host=$host", $user, $ +pw) or die "Can't connect to Oracle database: $DBI::errstr\n"; my $sql = qq{ SELECT $fields FROM t_activ_instrument where fps_subject + = '$symbol' }; my $sth = $dbh->prepare($sql); $sth->execute(); my $columns = join("<th>", @{ $sth->{NAME} }); my @row; while(@row = $sth->fetchrow_array) { print $q->table({-scope=>"col", -border=>2, -cellpadding => 5}, $q->th("$columns"), $q->Tr($q->td( join("<td>", @row), "\n")), ); }; $sth->finish; $dbh->disconnect; print $q->end_html; print "\r\n";
    Like I said outside the browser looks great. Inside the browser all I get is this (consolidated the style section):
    <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-U +S"> <head> <title>XREF</title> <style type="text/css"> <style> . . . </style> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1 +" /> </head> <body> <h1>ACTIV INSTRUMENT TABLE DATA</h1>

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.