G'day frank1,

Welcome to the Monastery.

Firstly, I think you should define exactly what you mean by extension. For instance, is the extension of archive.tar.gz, .tar.gz or tar.gz or .gz or gz?

As you've already loaded File::Basename, you could use its fileparse() function. This function can be tricky; in particular, the @suffixes argument is a list of patterns. Consider these:

$ perl -E 'use File::Basename; say "|$_|" for fileparse("X.tgz", qw{.g
+z .tgz})'
|X.|
|./|
|tgz|

$ perl -E 'use File::Basename; say "|$_|" for fileparse("X.tgz", qw{\.
+gz \.tgz})'
|X|
|./|
|.tgz|
[download]

And the order of the patterns matters. Consider these:

$ perl -E 'use File::Basename; say "|$_|" for fileparse("X.tar.gz", qw
+{\.gz \.tgz \.tar\.gz})'
|X.tar|
|./|
|.gz|

$ perl -E 'use File::Basename; say "|$_|" for fileparse("X.tar.gz", qw
+{\.tgz \.tar\.gz \.gz})'
|X|
|./|
|.tar.gz|
[download]

If all you want is the final part after the last '.', or a zero-length string if no such part exists, you can avoid the overhead, and possible frustration, of getting the patterns correct and in the right order, with simple functions which operate on strings (these are typically much faster than regexes but, in the scenario you present, I doubt that will matter much, if at all). This expression will do that for you:

substr $filename, rindex($filename, ".") + 1 || length $filename
[download]

And here it is in action, with an assortment of filenames with zero or more '.'s and with and without an actual extension.

$ perl -E '
    say "oldfile\t ext \tnewfile";
    say "-------\t --- \t-------";

    my $newname = "edddd";

    for (qw{OPQ.RST .U V. .W. X.Y Z . ..}) {
        my $ext = substr $_, rindex($_, ".") + 1 || length;
        say "$_\t|$ext|\t$newname" . (length $ext ? ".$ext" : "");
    }
'
oldfile  ext    newfile
-------  ---    -------
OPQ.RST |RST|   edddd.RST
.U      |U|     edddd.U
V.      ||      edddd
.W.     ||      edddd
X.Y     |Y|     edddd.Y
Z       ||      edddd
.       ||      edddd
..      ||      edddd
[download]

Now that you mention it, there is also the Apache notion of extensions, where foo.html.en.gz and foo.en.gz.html both have three extensions: en, html, and gz. This probably is not what our questioner is looking for, but this is part of a file-upload tool and it could be a security problem: Apache can recognize foo.cgi.png as a CGI script!

The infamous examples of this were of the form foo.php.jpg. If an upload script uses the name given during upload, that will run an alleged JPEG image through PHP when it is later viewed. Remote code execution, anyone?

For a file upload script, always store the file on the server under a machine-generated name and always ensure that the extension is derived from the Content-Type and/or inspection of the uploaded data, restricted to "safe" types and confirmed by inspecting the uploaded data. The uploaded file can be presented with any name and you cannot trust the information provided by the remote client.

++ All good points and good advice.

— Ken

The file system doesn't care about extensions. If you wish to retain the extension (or add a different one), then you will have to add that explicitly to the new name.

use CGI;
use CGI::Carp qw ( fatalsToBrowser );
use File::Basename;

my $upload_dir = "upload/";

my $query = new CGI;
my $filename = $query->param("file");

my $upload_filehandle = $query->upload("file");

my $ext = "jpg"; # this can be dynamic based on checking what kind of 
+file it is
my $newname = "edddd.$ext";
my $fileto = rename($filename, $newname);

open ( my $UPLOADFILE, ">", $upload_dir/$fileto" ) or die "$!";
binmode $UPLOADFILE;

while ( <$upload_filehandle> ) {
  print $UPLOADFILE;
}
[download]

Another note is that rename is like mv, which means that you're actually doing a cp and rm (of the original file) if crossing file system boundaries. If this is all happening on the same file system, then it's an atomic rename (fully done or not at all). The "copy" scenario introduces possible file corruption, and what I like to do in that case is an explicit copy, verify the $newname against the $filename, them unlink the $filename.

Update - added my $ to lexical file handle I added to the script.

Update - added $ to lexical file handle I added to the script.

I'm not sure if the quotation applies to the
    open ( $UPLOADFILE, ">", $upload_dir/$fileto" ) or die "$!";
statement or not, but if it does, please be aware that a sigil does not a lexical make.

Strictures are not enabled in the code here, so $UPLOADFILE just autovivifies a package-global scalar filehandle where UPLOADFILE would have been a package-global bareword filehandle. For a true lexical, use my:
    open ( my $UPLOADFILE, ">", $upload_dir/$fileto" ) or die "$!";
Of course, the script in question is short enough that lexical-versus-global filehandle won't make any practical difference.

---

Give a man a fish:  <%-{-{-{-<

Thanks, fixed. Oversight.

If this is all happening on the same file system, then it's an atomic rename (fully done or not at all).

It's not quite that simple. While rename(2) is supposed to be atomic on POSIXish systems, there are several of corner cases where that isn't completely reliable (e.g. NFS). One really has to know what OS and filesystem one is working on.

Thank you for clarifying this point, I almost mentioned NFS. OP didn't seem quite ready for a lesson of file systems, but I did want to relate it to what might actually be happening since they were thinking the operations were extension or file type aware. I also assumed they were coming from a more vulgar environment, like Windows (but used unix commands to illustrate the point nonetheless). That and using old skool CGI from 1990 seem to go hand in glove

I just noticed that the following statement in this post has an unbalanced double-quote:


open ( my $UPLOADFILE, ">", $upload_dir/$fileto" ) or die "$!";
                            ^                  ^
                            |                  |
                            +------------------+
[download]

A bit late, but...

---

Give a man a fish:  <%-{-{-{-<

thanks

Maybe just mark this code as untested :)

---

Give a man a fish:  <%-{-{-{-<

your dream has come true

use CGI;
use CGI::Carp qw ( fatalsToBrowser );
use File::Basename;

my $upload_dir = "upload/";

my $query = new CGI;
my $filename = $query->param("file");

my $upload_filehandle = $query->upload("file");

$newname = "edddd";

my ($ext) = $filename =~ /([^.]+)$/;
my $newfile = "$newname.$ext";

open ( UPLOADFILE, ">$upload_dir/$newfile" ) or die "$!";
binmode UPLOADFILE;

while ( <$upload_filehandle> )
{
print UPLOADFILE;
}

close UPLOADFILE;
[download]

You pull in File::Basename, but then manually extract the extension with a regular expression. And probably doesn't do what you mean if $filename doesn't have an extension in it (in which case $newfile will be (effectively) "$newname.$filename" instead).

The cake is a lie.
The cake is a lie.
The cake is a lie.

wow this is awesome, this is what i have been looking for, much thanks