minor fixes
[sgn.git] / lib / CXGN / UploadFile.pm
blob943ebe2ec71ef8af6c4cbeadfc068e3255ca28a9
1 package CXGN::UploadFile;
3 =head1 NAME
5 CXGN::UploadFile - an object to handle uploading files
7 =head1 USAGE
9 my $uploader = CXGN::UploadFile->new();
10 my $uploaded_file = $uploader->archive($c,$subdirectory,$tempfile,$archive_filename);
11 my $md5 = $uploader->get_md5($uploaded_file);
13 =head1 DESCRIPTION
16 =head1 AUTHORS
18 Jeremy D. Edwards (jde22@cornell.edu)
20 =cut
22 use strict;
23 use warnings;
24 use Moose;
25 use Try::Tiny;
26 use List::MoreUtils qw /any /;
27 use File::Copy;
28 use File::Spec::Functions;
29 use File::Basename qw | basename dirname|;
30 use Digest::MD5;
32 sub archive {
33 my $self = shift;
34 my $c = shift;
35 my $subdirectory = shift;
36 my $tempfile = shift;
37 my $archive_filename = shift;
38 my $timestamp = shift;
39 my $archive_path = $c->config->{archive_path};
40 my $user_id;
41 my $user_name;
42 my $archived_file_name;
43 my $file_destination;
44 my $error;
45 if (!$c->user()) { #user must be logged in
46 die "You need to be logged in to archive a file.\n";
48 if (!any { $_ eq "curator" || $_ eq "submitter" } ($c->user()->roles) ) {
49 die "You have insufficient privileges to archive a file.\n";
51 if (!$subdirectory || !$tempfile || !$archive_filename ) {
52 die "File archive failed: incomplete information to archive file.\n";
54 $user_id = $c->user()->get_object()->get_sp_person_id();
55 $user_name = $c->user()->get_object()->get_username();
56 $file_destination = catfile($archive_path, $user_id, $subdirectory,$timestamp."_".$archive_filename);
57 try {
58 if (!-d $archive_path) {
59 mkdir $archive_path;
61 if (! -d catfile($archive_path, $user_id)) {
62 mkdir (catfile($archive_path, $user_id));
64 if (! -d catfile($archive_path, $user_id, $subdirectory)) {
65 mkdir (catfile($archive_path, $user_id, $subdirectory));
67 copy($tempfile,$file_destination);
68 } catch {
69 $error = "Error saving archived file: $file_destination\n$_";
71 if ($error) {
72 die "$error\n";
74 return $file_destination;
77 sub get_md5 {
78 my $self = shift;
79 my $file_name_and_location = shift;
80 print STDERR $file_name_and_location;
82 open(my $F, "<", $file_name_and_location) || die "Can't open file ";
83 binmode $F;
84 my $md5 = Digest::MD5->new();
85 $md5->addfile($F);
86 close($F);
87 return $md5;
90 ###
92 ###