How to find if file is readable by all? - perl

How to find if a file is readable by everyone in UNIX?

The (relatively) modern solution: use File::stat, a core module since 5.004, and Fcntl, which has always been in Perl 5. See also perldoc -f stat.
use strict;
use warnings;
use File::stat;
use Fcntl qw(:mode);
...
my $mode = stat($filename)->mode;
my $allCanRead = ($mode & S_IRUSR) # User can read
&& ($mode & S_IRGRP) # Group can read
&& ($mode & S_IROTH); # Others can read

From perldoc:
$mode = (stat($filename))[2];
printf "Permissions are %04o\n", $mode & 07777;
To extract read-for-others bit you can do
print "read for everyone" if $mode & 4; # pick bit 2 from mode

Use the stat function.

Related

Unexpected output from perl script

The following script produces no output:
use File::stat;
use Time::localtime;
my $filename = 'c:\testfile';
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks)
= stat($filename);
print("$mtime");
c:\testfile exists.
I've seen several answers on SO -- this, for example -- which seem to suggest that the array returned by stat() should have something meaningful in it, but I haven't seen that to be the case in practice.
This is 64 bit ActivePerl on Windows 7.
Does stat not do what those answers seemed to imply, or do Perl's file date/time functions not work under Windows (or 64 bit Windows, or some such?)
This works fine:
#!perl
use strict;
use warnings;
my $filename = 'c:\Users\username\Documents\asdf23rasdf.pl';
my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev,
$size, $atime, $mtime, $ctime, $blksize, $blocks
) = stat($filename);
print($mtime);
As alluded to in the comments - Perl's built-in stat works like the above. You don't need to use File::Stat or File::stat in order to do that. They just provide different interfaces to the same functionality.
If you want to do it with File::stat it goes like this:
use File::stat;
my $filename = 'c:\Users\username\Documents\asdf23rasdf.pl';
my $stats = stat($filename);
print( $stats -> mtime);
File::stat replaces stat with one that has a different interface. Remove use File::stat; or use its stat appropriately.

Detect and Display of operating system using Perl

I want to display my computer's operating system using Perl. I thought the following would do
#!/usr/bin/perl
use strict;
use warnings;
my $os = $^O;
print "$os\n";
But the output I got is
linux
I want the output to be displayed as
Windows XP
How to do this? Please help. Thanks in advance.
Use the uname() function that the POSIX module provides for you.
All Perl distributions come with the Config module. This module is a bit rickety because it imports the hash %Config, but it's an easy way to get access to all sorts of Perl configuration information.
use Config; # This exports a %Config hash
print "My OS is $Config{osname}\n";
print "My OS version is $Config{osvers}\n";
print "My Architecture Family is $Config{archname}\n";
#
# Print out all of the keys, and see which one looks like one
# you can use. "ld" is actually a rather nice value
#
for my $key (sort keys %Config) {
no warnings qw(uninitialized); # Some elements have undef values
print qq($key: "$Config{$key}"\n);
}
Are you perhaps looking for
use CGI qw( );
use HTTP::BrowserDetect qw( );
my $cgi = CGI->new();
print $cgi->header('text/plain');
my $bd = HTTP::BrowserDetect->new($cgi->user_agent());
print $bd->os_string(), "\n";

How to use Term::ReadLine to retrieve command history?

I've the following script, which is almost the same of the sample in synopsis paragraph in documentation.
use strict;
use warnings;
use Term::ReadLine;
my $term = Term::ReadLine->new('My shell');
print $term, "\n";
my $prompt = "-> ";
while ( defined ($_ = $term->readline($prompt)) ) {
print $_, "\n";
$term->addhistory($_);
}
It executes with no error, but unfortunately, even if I click the Up Arrow, I only get ^[[A and no history. What am I missing?
The print $term statement prints Term::ReadLine::Stub=ARRAY(0x223d2b8).
Since we are here, I noticed it prints the prompt underlined... but I can't find in the docs anything which could prevent it. Is there any way to avoid it?
To answer the main question, you probably don't have a good Term::ReadLine library installed. you will want either 'perl-Term-ReadLine-Perl' or 'perl-Term-ReadLine-Gnu'. These are the fedora package names, but i'm sure that the ubuntu/debian names would be similar. I believe you could also get them from CPAN, but I haven't tested that. If you haven't installed the package, perl loads a dummy module that has almost no features. for this reason history was not part of it.
The underline is part of what readline calls ornaments. if you want to turn them off completely, add $term->ornaments(0); somewhere apropriate.
my rewrite of your script is as follows
#!/usr/bin/perl
use strict;
use warnings;
use Term::ReadLine; # make sure you have the gnu or perl implementation of readline isntalled
# eg: Term::ReadLine::Gnu or Term::ReadLine::Perl
my $term = Term::ReadLine->new('My shell');
my $prompt = "-> ";
$term->ornaments(0); # disable ornaments.
while ( defined ($_ = $term->readline($prompt)) ) {
print $_, "\n";
$term->addhistory($_);
}

Using a subroutine from another file

Consider:
File display.pl
disp{
my $p = shift;
print $p;
}
File temp.pl
require "display.pl";
$item = "asd";
&disp($item);
When I executed temp.pl, it gave an error:
can't find method "disp" without a package or a object reference at display.pl line 2.
You forgot to write sub before disp{ in display.pl, so Perl doesn't know that you are trying to define a function.
Always use strict and warnings, and you will avoid such problems. Also, as noted by #NEW, you need to end display.pl with a 1; because require requires that a file end with a true value.
Corrected, your code would be:
use strict;
use warnings;
sub disp {
my $p = shift;
print $p;
}
1;
Avoid errors by using
use strict ;
use warnings;
Note that you need the 1; at the end of the file like
sub disp{
my $p=shift;
print $p;
}
1;
This is because Perl needs the last expression in the file to return a true value.
If the require file (display.pl) is in another directory you will need to specify the absolute path:
You don't need to worry about recursive requiring (e.g. requiring a file that requires the current file), Perl will handle everything.
SEE ALSO
perldoc -f require and perldoc -q require and perldoc perlmod for better understanding.

How can I calculate the MD5 hash of a wav file in Perl?

I have a wav file and I need to calculate the MD5 hash of its contents. How can i do that using Perl?
There is module for it: Digest::MD5::File. With it the code is simplified to:
use Digest::MD5::File qw( file_md5_hex );
my $md5 = file_md5_hex( $some_file_name );
Sure you can. Just look for Digest::MD5 for the hashing part, and any WAV-related module if you want to hash a specific part of the file (skipping metadata, for example).
Using the Digest::MD5
use Digest::MD5 qw(md5);
my $hash;
{
local $/ = undef;
open FILE, "$wav_file_name";
binmode FILE;
my $data = <FILE>;
close FILE;
$hash = md5($data);
}
or you could use the OO interface:
use Digest::MD5;
open FILE, "$wav_file_name";
my $ctx = Digest::MD5->new;
$ctx->addfile (*FILE);
my $hash = $ctx->digest;
close (FILE);
The following, based on a comment by user hexten, is working for me and should perform better than the answers that slurp the file:
use Digest::MD5 qw( md5_hex );
open my $fh, '<', $file;
my $md5 = Digest::MD5->new->addfile($fh)->hexdigest;
close $fh;
The (currently) top-voted answer suggests using Digest::MD5::File, but that does not work for me at least on the latest Windows build of ActiveState Perl, and the link in the answer is now dead.
Simply use Digest::MD5.
Depending upon your needs, Perceptual Hashing may be interesting too, by the way. It allows you to compare files by comparing their hashes (similar contents have similar hashes). However there still isn't any perl implementation AFAIK.
Using File::Slurp with Digest::MD5:
#!/usr/bin/perl
use strict;
use warnings;
use Digest::MD5 qw(md5_hex);
use File::Slurp;
my ($input) = #ARGV;
write_file "$input.md5", md5_hex(scalar read_file $input, binmode => ':raw'), "\n";
Or Digest::file -
Perl v5.20.2 in Debian Jessie
# Poor mans "md5sum" command
use Digest::file qw(digest_file_hex);
for (#ARGV) {
print digest_file_hex($_, "MD5"), " $_\n";
}