Apache2-ASP

 view release on metacpan or  search on metacpan

lib/Apache2/ASP/MediaManager.pm  view on Meta::CPAN

sub compose_download_file_path
{
  my ($s, $context) = @_;
  
  # Compose the local filename:
  my $file = $context->request->Form->{file};
  my $filename = $context->config->web->media_manager_upload_root . '/' . $file;
  
  return $filename;
}# end compose_file_path()


#==============================================================================
sub compose_download_file_name
{
  my ($s, $context) = @_;
  
  # Compose the local filename:
  my $file = $context->request->Form->{file};
  
  return $file;
}# end compose_file_name()


#==============================================================================
sub compose_upload_file_name
{
  my ($s, $context, $Upload) = @_;
  
#  my $filename = $Upload;
  my ($filename) = $Upload->{upload}->{upload_filename} =~ m/.*[\\\/]([^\/\\]+)$/;
  if( ! $filename )
  {
    $filename = $Upload->{upload}->{upload_filename};
  }# end if()
  
  return $filename;
}# end compose_upload_file_name()


#==============================================================================
sub compose_upload_file_path
{
  my ($s, $context, $Upload, $filename) = @_;
  
  unless( defined($filename) && length($filename) )
  {
    die "\$filename not provided";
  }# end unless()
  
  return $context->config->web->media_manager_upload_root . "/$filename";
}# end compose_upload_file_path()


#==============================================================================
sub upload_start
{
  my ($s, $context, $Upload) = @_;
  
  shift(@_);
  $s->SUPER::upload_start( $context, $Upload );

  my $filename = $s->compose_upload_file_name( @_ );
  
  # Make sure we can open the file for writing:
  my $target_file = $s->compose_upload_file_path( $context, $Upload, $filename);
  
  # Open the file for writing:
  my $ofh = $s->open_file_for_writing($context, $target_file);
  print $ofh delete($Upload->{data});
  
  # Done with the filehandle:
  $ofh->close;
  
  # Store some information for later:
  $ENV{filename} ||= $target_file;
  $ENV{download_file} ||= $filename;
  
  # Depending on the 'mode' parameter, we do different things:
  local $_ = $s->_args('mode');
  if( /^create$/ )
  {
    $s->before_create($context, $Upload);
  }
  elsif( /^edit$/ )
  {
    $s->before_update($context, $Upload);
  }
  else
  {
    die "Unknown mode: '$_'";
  }# end if()
}# end upload_start()


#==============================================================================
sub upload_hook
{
  my ($s, $context, $Upload) = @_;
  
  shift(@_);
  $s->SUPER::upload_hook( @_ );
  
  my $filename = eval {
    my $name = $ENV{filename}; # $context->r->pnotes( 'filename' );
    $name;
  } or return;
  
  my $ofh = $s->open_file_for_appending($context, $filename);
  no warnings 'uninitialized';
  print $ofh delete($Upload->{data});
  $ofh->close;
}# end upload_hook()


#==============================================================================
sub upload_end
{
  my ($s, $context, $Upload) = @_;
  
  shift(@_);
  $s->SUPER::upload_end( @_ );
  
  # Return information about what we just did:
  my $info = {
    new_file      => $ENV{filename},
    filename_only => $ENV{download_file},
    link_to_file  => "/media/" . $ENV{download_file},
  };
  $Upload->{$_} = $info->{$_} foreach keys(%$info);
  
  # Depending on the 'mode' parameter, we do different things:
#  local $_ = $context->request->Form->{mode};
  my $form = $context->request->Form;
  $form = $context->request->Form;
  if( $form->{mode} =~ /^create$/ )
  {
    $s->after_create($context, $Upload);
  }
  elsif(  $form->{mode} =~ /^edit$/ )
  {
    $s->after_update($context, $Upload);
  }
  else
  {
    die "Unknown mode: '$_'";
  }# end if()
}# end upload_end()


#==============================================================================
sub before_download
{
  my ($s, $context) = @_;
  
}# end before_download()


#==============================================================================
sub after_download
{
  my ($s, $context) = @_;
  
}# end after_download()


#==============================================================================
sub before_create
{
  my ($s, $context, $Upload) = @_;
  1;
}# end before_create()


#==============================================================================
sub before_update
{
  my ($s, $context, $Upload) = @_;
  1;
}# end before_update()




( run in 1.124 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )