add version numbers to all modules
[bse.git] / site / cgi-bin / modules / DevHelp / FileUpload.pm
1 package DevHelp::FileUpload;
2 use strict;
3 use IO::File;
4 use File::Copy;
5
6 our $VERSION = "1.000";
7
8 =head1 NAME
9
10   DevHelp::FileUpload - tools to maintain a file upload directory
11
12 =head1 SYNOPSIS
13
14   use DevHelp::FileUpload;
15
16   my $msg;
17   my ($name, $handle) = 
18     DevHelp::FileUpload->make_img_filename($image_dir, $original_name, \$msg)
19       or die $msg;
20   my $newname = 
21     DevHelp::FileUpload->make_img_copy($image_dir, $oldname, \$msg)
22       or die $msg;
23
24 =head1 DESCRIPTION
25
26 =over
27
28 =item DevHelp::FileUpload->make_img_copy($imgdir, $oldname, \$msg)
29
30 =cut
31
32 sub make_img_copy {
33   my ($class, $imgdir, $oldname, $rmsg) = @_;
34
35   # remove the time value and optional counter
36   (my $workname = $oldname) =~ s/^\d+_(?:\d+_)?//;
37
38   my ($newname, $fh) = $class->make_img_filename($imgdir, $workname, $rmsg)
39     or return;
40
41   unless (copy("$imgdir/$oldname", $fh)) {
42     $$rmsg = "Cannot copy to new file: $!";
43     close $fh; undef $fh;
44     unlink "$imgdir/$newname";
45     return;
46   }
47     
48   close $fh;
49   undef $fh;
50
51   return $newname;
52 }
53
54 =item DevHelp::FileUpload->make_img_filename($imgdir, $name, \$msg)
55
56 =cut
57
58 sub make_img_filename {
59   my ($class, $imgdir, $name, $rmsg) = @_;
60
61   my $basename = '';
62   $name =~ /([\w.-]+)$/ and $basename = $1;
63
64   if (length $basename > 60) {
65     $basename = substr($basename, -60);
66   }
67
68   my $filename = time . '_' . $basename;
69
70   my $fh;
71   my $counter = "";
72   $filename = time . '_' . $counter . '_' . $basename
73     until $fh = IO::File->new("$imgdir/$filename", O_CREAT | O_WRONLY | O_EXCL)
74       or ++$counter > 100;
75
76   unless ($fh) {
77     $$rmsg = "Could not open image file $imgdir/$filename: $!";
78     return;
79   }
80
81   binmode $fh;
82
83   return ($filename, $fh);
84 }
85
86 =back
87
88 =head1 AUTHOR
89
90 Tony Cook <tony@develop-help.com>
91
92 =cut
93
94 1;