Is there a perl script to add owner's/authors name of the file?
my $owner = getpwuid((stat($file))[4]);
see stat and getpwuid for more detail.
Update: for Windows,
from this post: http://www.perlmonks.org/?node_id=865219
use Win32::OLE;
my $objShell = Win32::OLE->CreateObject("Shell.Application");
my $objFolder=$objShell->Namespace("c:\\a") or die "$!" ;
my $a = $objFolder->ParseName("a.txt") or die "$!" ;
print $objFolder->GetDetailsOf($a, 8) or die "$!" ;
or,
use Win32::Perms;
my $username = Win32::Perms->new($filename)->Owner;
#!/usr/bin/perl -w
my #sb = stat "/etc/passwd";
my $userid = $sb[4];
my #pwent = getpwuid $userid;
my $username = $pwent[0];
print "/etc/passwd is owned by $username\n";
$ /tmp/foo.pl
/etc/passwd is owned by root
The perldoc perlfunc guide has lots of information on these families of functions.
Related
For example:
#!/usr/bin/perl
...
my $host = $db_conf->{host};
my #cmd = ('date',$host);
system(#cmd);
So the results i am expecting is:
Fri Aug 11 15:41:28 CST 2017 db-test-1
With db-test-1 being the hostname.
Here is my entire code:
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use DBI;
use Encode;
use IO::File;
use JSON;
use utf8;
BEGIN {
binmode STDERR, ':utf8';
binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';
}
INIT {
my #databases = </kkcorp/kksecret/db-*/db.json>;
foreach my $filename (#databases) {
my $fh = IO::File->new($filename, 'r') or croak $!;
my #buf = <$fh>;
my $str = join '', #buf;
$fh->close;
my $db_conf = decode_json $str;
my $entry = int(rand(scalar(#{$db_conf})));
$db_conf = $db_conf->[$entry]->{writer}->{params};
my $host = $db_conf->{host};
my $dbname = $db_conf->{dbname};
my $password = $db_conf->{password};
my $username = $db_conf->{username};
my $wsrep_check = `mysql -h $host -u $username -p$password < /authdir/auto_inc_script.sql`;
$hosti
if (index($wsrep_check, 'Value: Synced') != -1) {
my #cmd = ('date ${host}');
system(#cmd);
my #wsrep_check_lines = split /\n/, $wsrep_check;
my #table_name = grep { /Synced/ } #wsrep_check_lines;
for my $line (#table_name){
say STDERR $line;
}
say '';
}
}
}
__END__
So what i am trying to achieve in in the two statements right after the beginning of the "if" statement. The code runs fine, but ignored the ${host} variable without displaying any output for it.
Below is my results:
Fri Aug 11 17:13:19 CST 2017
ok Value: Synced
Fri Aug 11 17:13:20 CST 2017
ok Value: Synced
system is very powerful but also very dangerous. It is easy to make disasters, consider, if you feed it with an rm, better if you make absolutely clear what parameters rm gets before running system.
For this reason I always follow this practice:
create the commad string
print the command string
check if print representation is what i want to send to the shell
add the system part
Here is an example, from the command line:
perl -e ' $var = "Hello"; $cmd = qq(echo $var); print "The command: $cmd \n";'
Next, add system:
perl -e ' $var = "Hello"; $cmd = qq(echo $var); print "the command: $cmd \n"; system($cmd);'
I've written this script (called SpeedTest.pl) to log internet speed due to resolve a problem with my ISP.
It work well, but just if I use a Perl interpreter (if I double-click on the script). I want to compile it to generate a stand-alone executable to run in a different PC without Perl installed.
Well, I've try with pp and Perl2Exe both, but when I launch the SpeedTest.exe i see a lot of process called "SpeedTest.exe" in task manager. If I don't block all these process, the PC OS will crash (a pop-up say: "the memory can't be written, blah blah blah).
Any ideas?
This is the script:
#!/usr/local/bin/perl
use strict;
use warnings;
use App::SpeedTest;
my($day, $month_temp, $year_temp)=(localtime)[3,4,5];
my $year = $year_temp+1900;
my $month = $month_temp+1;
my $date = "0"."$day"."-"."0"."$month"."-"."$year";
my $filename = "Speed Test - "."$date".".csv";
if (-e $filename) {
goto SPEEDTEST;
} else {
goto CREATEFILE;
}
CREATEFILE:
open(FILE, '>', $filename);
print FILE "Date".";"."Time".";"."Download [Mbit/s]".";"."Upload [Mbit/s]".";"."\n";
close FILE;
goto SPEEDTEST;
SPEEDTEST:
my $download = qx(speedtest -Q -C --no-upload);
my $upload = qx(speedtest -Q -C --no-download);
my #download_chars = split("", $download);
my #upload_chars = split("", $upload);
my $time = "$download_chars[12]"."$download_chars[13]"."$download_chars[14]"."$download_chars[15]"."$download_chars[16]";
my $download_speed = "$download_chars[49]"."$download_chars[50]"."$download_chars[51]"."$download_chars[52]"."$download_chars[53]";
my $upload_speed = "$upload_chars[49]"."$upload_chars[50]"."$upload_chars[51]"."$upload_chars[52]"."$upload_chars[53]";
my $output = "$date".";"."$time".";"."$download_speed".";"."$upload_speed".";";
open(FILE, '>>', $filename);
print FILE $output."\n";
close FILE;
sleep 300;
my($day_check, $month_temp_check, $year_temp_check)=(localtime)[3,4,5];
my $year_check = $year_temp_check+1900;
my $month_check = $month_temp_check+1;
my $date_check = "0"."$day_check"."-"."0"."$month_check"."-"."$year_check";
my $filename_check = "Speed Test - "."$date_check".".csv";
if ($filename = $filename_check) {
goto SPEEDTEST;
} else {
$filename = $filename_check;
goto CREATEFILE;
}
Well, Steffen really answered this by way of a Comment, but here it is as an Answer. Just compile your Perl into an EXE that does NOT have the same name as the one that the Perl script is calling, for example:
speedtest.pl compiled into myspeedtest.exe, which calls speedtest.exe
See the discussion at Is `command -v` option required in a POSIX shell? Is posh compliant with POSIX?. It describes that type as well as command -v option is optional in POSIX.1-2004.
The answer marked correct at Check if a program exists from a Bash script doesn't help either. Just like type, hash is also marked as XSI in POSIX.1-2004. See http://pubs.opengroup.org/onlinepubs/009695399/utilities/hash.html.
Then what would be a POSIX compliant way to write a shell script to find if a command exists on the system or not?
How do you want to go about it? You can look for the command on directories in the current value of $PATH; you could look in the directories specified by default for the system PATH (getconf PATH as long as getconf
exists on PATH).
Which implementation language are you going to use? (For example: I have a Perl implementation that does a decent job finding executables on $PATH — but Perl is not part of POSIX; is it remotely relevant to you?)
Why not simply try running it? If you're going to deal with Busybox-based systems, lots of the executables can't be found by searching — they're built into the shell. The major caveat is if a command does something dangerous when run with no arguments — but very few POSIX commands, if any, do that. You might also need to determine what command exit statuses indicate that the command is not found versus the command objecting to not being called with appropriate arguments. And there's little guarantee that all systems will be consistent on that. It's a fraught process, in case you hadn't gathered.
Perl implementation pathfile
#!/usr/bin/env perl
#
# #(#)$Id: pathfile.pl,v 3.4 2015/10/16 19:39:23 jleffler Exp $
#
# Which command is executed
# Loosely based on 'which' from Kernighan & Pike "The UNIX Programming Environment"
#use v5.10.0; # Uses // defined-or operator; not in Perl 5.8.x
use strict;
use warnings;
use Getopt::Std;
use Cwd 'realpath';
use File::Basename;
my $arg0 = basename($0, '.pl');
my $usestr = "Usage: $arg0 [-AafhqrsVwx] [-p path] command ...\n";
my $hlpstr = <<EOS;
-A Absolute pathname (determined by realpath)
-a Print all possible matches
-f Print names of files (as opposed to symlinks, directories, etc)
-h Print this help message and exit
-q Quiet mode (don't print messages about files not found)
-r Print names of files that are readable
-s Print names of files that are not empty
-V Print version information and exit
-w Print names of files that are writable
-x Print names of files that are executable
-p path Use PATH
EOS
sub usage
{
print STDERR $usestr;
exit 1;
}
sub help
{
print $usestr;
print $hlpstr;
exit 0;
}
sub version
{
my $version = 'PATHFILE Version $Revision: 3.4 $ ($Date: 2015/10/16 19:39:23 $)';
# Beware of RCS hacking at RCS keywords!
# Convert date field to ISO 8601 (ISO 9075) notation
$version =~ s%\$(Date:) (\d\d\d\d)/(\d\d)/(\d\d) (\d\d:\d\d:\d\d) \$%\$$1 $2-$3-$4 $5 \$%go;
# Remove keywords
$version =~ s/\$([A-Z][a-z]+|RCSfile): ([^\$]+) \$/$2/go;
print "$version\n";
exit 0;
}
my %opts;
usage unless getopts('AafhqrsVwxp:', \%opts);
version if ($opts{V});
help if ($opts{h});
usage unless scalar(#ARGV);
# Establish test and generate test subroutine.
my $chk = 0;
my $test = "-x";
my $optlist = "";
foreach my $opt ('f', 'r', 's', 'w', 'x')
{
if ($opts{$opt})
{
$chk++;
$test = "-$opt";
$optlist .= " -$opt";
}
}
if ($chk > 1)
{
$optlist =~ s/^ //;
$optlist =~ s/ /, /g;
print STDERR "$arg0: mutually exclusive arguments ($optlist) given\n";
usage;
}
my $chk_ref = eval "sub { my(\$cmd) = \#_; return -f \$cmd && $test \$cmd; }";
my #PATHDIRS;
my %pathdirs;
my $path = defined($opts{p}) ? $opts{p} : $ENV{PATH};
#foreach my $element (split /:/, $opts{p} // $ENV{PATH})
foreach my $element (split /:/, $path)
{
$element = "." if $element eq "";
push #PATHDIRS, $element if $pathdirs{$element}++ == 0;
}
my $estat = 0;
CMD:
foreach my $cmd (#ARGV)
{
if ($cmd =~ m%/%)
{
if (&$chk_ref($cmd))
{
print "$cmd\n" unless $opts{q};
next CMD;
}
print STDERR "$arg0: $cmd: not found\n" unless $opts{q};
$estat = 1;
}
else
{
my $found = 0;
foreach my $directory (#PATHDIRS)
{
my $file = "$directory/$cmd";
if (&$chk_ref($file))
{
$file = realpath($file) if $opts{A};
print "$file\n" unless $opts{q};
next CMD unless defined($opts{a});
$found = 1;
}
}
print STDERR "$arg0: $cmd: not found\n" unless $found || $opts{q};
$estat = 1;
}
}
exit $estat;
I have a directory full of files (text exports of Dynamics NAV objects that have been exported) in Windows. Each file contains multiple objects. I need to split each file into separate files based on lines that begin with OBJECT, and name each file appropriately.
The purpose of this is to get our Dynamics NAV system into git.
I wrote a nifty perl program to do this that works great on linux. But it hangs on the while(<>) loop in Windows (Server 2012 if that matters).
So, I need to either figure out how to do this in the PowerShell script that I wrote that generates all of the files, or fix my perl script that I'm calling from PowerShell. Does Windows perl handle filehandles differently than linux?
Here's my code:
#!/usr/bin/perl
use strict;
use warnings;
use File::Path qw(make_path remove_tree);
use POSIX qw(strftime);
my $username = getlogin || getpwuid($<);
my $datestamp = strftime("%Y%m%d-%H%M%S", localtime);
my $work_dir = "/temp/nav_export";
my $objects_dir = "$work_dir/$username/objects";
my $export_dir = "$work_dir/$username/$datestamp";
print "Objects being exported to $export_dir\n";
make_path("$export_dir/Page", "$export_dir/Codeunit", "$export_dir/MenuSuite", "$export_dir/Query", "$export_dir/Report", "$export_dir/Table", "$export_dir/XMLport");
chdir $objects_dir or die "Could not change to $objects_dir: $!";
# delete empty files
foreach(glob('*.*')) {
unlink if -f and !-s _;
}
my #files = <*>;
my $count = #files;
print "Processing $count files\n";
open (my $fh, ">-") or die "Could not open standard out: $!";
# OBJECT Codeunit 1 ApplicationManagement
while(<>)
{
if (m/^OBJECT ([A-Za-z]+) ([0-9]+) (.*)/o)
{
my $objectType = $1;
my $objectID = $2;
my $objectName = my $firstLine = $3;
$objectName =~ s/[\. \/\(\)\\]/_/g; # translate spaces, (, ), ., \ and / to underscores
$objectName =~ tr/\cM//d; # get rid of Ctrl-M
my $filename = $export_dir . "/" . $objectType . "/" . $objectType . "~" . $objectID . "~" . $objectName;
close $fh and open($fh, '>', $filename) or die "Could not open file '$filename' $!";
print $fh "OBJECT $objectType $objectID $firstLine\n";
next;
}
print $fh $_;
}
I've learned quite a bit of PowerShell in the past few days. There are some things that it really does quite well. And some (such as calling an executable with variables and command line options that have spaces) that are maddeningly difficult to figure out. To call curl, this is what I resorted to:
$curl = "C:\Program Files (x86)\cURL\bin\curl"
$arg10 = '-s'
$arg1 = '-X'
$arg11 = 'post'
$arg2 = '-H'
$arg22 = '"Accept-Encoding: gzip,deflate"'
$arg3 = '-H'
$arg33 = '"Content-Type: text/xml;charset=UTF-8"'
$arg4 = '-H'
$arg44 = '"SOAPAction:urn:microsoft-dynamics-schemas/page/permissionrange:ReadMultiple"'
$arg5 = '--ntlm'
$arg6 = '-u'
$arg66 = 'username:password'
$arg7 = '-d'
$arg77 = '"#soap_envelope.txt"'
$arg8 = "http://$servicetier.corp.company.net:7047/$database/WS/DBDOC/Page/PermissionRange"
$arg9 = "-o"
$arg99 = "c:\temp\nav_export\$env:username\raw_list.xml"
&"$curl" $arg10 $arg1 $arg11 $arg2 $arg22 $arg3 $arg33 $arg4 $arg44 $arg5 $arg6 $arg66 $arg7 $arg77 $arg8 $arg9 $arg99
I realize that part is a bit of a tangent. But I've been working really hard at trying to figure this out and not have to bother you nice folk here at stackoverflow!
I'm ambivalent about making it work in PowerShell or fixing the Perl code at this point. I just need to make it work. But I'm hoping it's just some little difference in filehandle handling between linux and Windows.
It's hard to believe that the Perl code that you show does anything on Linux either. It looks like your while loop is supposed to be reading through all of the files in the #files array, but to make it do that you have to copy the names to #ARGV.
Also note that #files will contain directories as well as files.
I suggest you change the lines starting with my #files = <*> to this. There's no reason why it shouldn't work on both Windows and Linux.
our #ARGV = grep -f, glob '*';
my $count = #ARGV;
print "Processing $count files\n";
my $fh;
while (<>) {
s/\s+\z//; # Remove trailing whitespace (including CR and LF)
my #fields = split ' ', $_, 4;
if ( #fields == 4 and $fields[0] eq 'OBJECT' ) {
my ($object_type, $object_id, $object_name) = #fields[1,2,3];
$object_name =~ tr{ ().\\/}{_}; # translate spaces, (, ), ., \ and / to underscores
my $filename = "$export_dir/$object_type/$object_type~$object_id~$object_name";
open $fh, '>', $filename or die "Could not open file '$filename': $!";
}
print $fh "$_\n" if $fh;
if (eof) {
close $fh;
$fh = undef;
}
}
Setup and Background
I am working on script that needs to run as /usr/bin/php-cgi instead /usr/local/bin/php and I'm having trouble checking for stdin
If I use /usr/local/bin/php as the interpreter I can do something like
if defined('STDIN'){ ... }
This doesn't seem to work with php-cgi - Looks to always be undefined. I checked the man page for php-cgi but didn't find it very helpful. Also, if I understand it correctly, the STDIN constant is a file handle for php://stdin. I read somewhere that constant is not supposed to be available in php-cgi
Requirements
The shebang needs to be #!/usr/bin/php-cgi -q
The script will sometimes be passed arguments
The script will sometimes receive input via STDIN
Current Script
#!/usr/bin/php-cgi -q
<?php
$stdin = '';
$fh = fopen('php://stdin', 'r');
if($fh)
{
while ($line = fgets( $fh )) {
$stdin .= $line;
}
fclose($fh);
}
echo $stdin;
Problematic Behavior
This works OK:
$ echo hello | ./myscript.php
hello
This just hangs:
./myscript.php
These things don't work for me:
Checking defined('STDIN') // always returns false
Looking to see if CONTENT_LENGTH is defined
Checking variables and constants
I have added this to the script and run it both ways:
print_r(get_defined_constants());
print_r($GLOBALS);
print_r($_COOKIE);
print_r($_ENV);
print_r($_FILES);
print_r($_GET);
print_r($_POST);
print_r($_REQUEST);
print_r($_SERVER);
echo shell_exec('printenv');
I then diff'ed the output and it is the same.
I don't know any other way to check for / get stdin via php-cgi without locking up the script if it does not exist.
/usr/bin/php-cgi -v yields: PHP 5.4.17 (cgi-fcgi)
You can use the select function such as:
$stdin = '';
$fh = fopen('php://stdin', 'r');
$read = array($fh);
$write = NULL;
$except = NULL;
if ( stream_select( $read, $write, $except, 0 ) === 1 ) {
while ($line = fgets( $fh )) {
$stdin .= $line;
}
}
fclose($fh);
Regarding your specific problem of hanging when there is no input: php stream reads are blocking operations by default. You can change that behavior with stream_set_blocking(). Like so:
$fh = fopen('php://stdin', 'r');
stream_set_blocking($fh, false);
$stdin = fgets($fh);
echo "stdin: '$stdin'"; // immediately returns "stdin: ''"
Note that this solution does not work with that magic file handle STDIN.
stream_get_meta_data helped me :)
And as mentioned in the previous answer by Seth Battin stream_set_blocking($fh, false); works very well 👍
The next code reads data from the command line if provided and skips when it's not.
For example:
echo "x" | php render.php
and php render.php
In the first case, I provide some data from another stream (I really need to see the changed files from git, something like git status | php render.php.
Here is an example of my solution which works:
$input = [];
$fp = fopen('php://stdin', 'r+');
$info = stream_get_meta_data($fp);
if (!$info['seekable'] && $fp) {
while (false !== ($line = fgets($fp))) {
$input[] = trim($line);
}
fclose($fp);
}
The problem is that you create a endless loop with the while($line = fgets($fh)) part in your code.
$stdin = '';
$fh = fopen('php://stdin','r');
if($fh) {
// read *one* line from stdin upto "\r\n"
$stdin = fgets($fh);
fclose($fh);
}
echo $stdin;
The above would work if you're passing arguments like echo foo=bar | ./myscript.php and will read a single line when you call it like ./myscript.php
If you like to read more lines and keep your original code you can send a quit signal CTRL + D
To get parameters passed like ./myscript.php foo=bar you could check the contents of the $argv variable, in which the first argument always is the name of the executing script:
./myscript.php foo=bar
// File: myscript.php
$stdin = '';
for($i = 1; $i < count($argv); i++) {
$stdin .= $argv[$i];
}
I'm not sure that this solves anything but perhaps it give you some ideas.