view release on metacpan or  search on metacpan

lib/Kwiki/UserPhoto.pm  view on Meta::CPAN

	    return $_->name if($_->name =~ /thumb./);
	}
    }
    return $self->config->user_photo_default;
}

sub user_photo {
    my $mode = $self->cgi->run_mode;
    # Valid modes: upload
    $self->$mode if($mode && $self->can($mode));
    $self->render_screen;
}

sub upload {
    require YAML;
    my $username = $self->users->current->name;
    my $file = $self->cgi->uploaded_file;
    return $self->display_msg("You must setup a proper user name to upload your photo") unless($username);
    if($file){
	my $fh = $file->{handle};
	my $newfile = io->catfile($self->plugin_directory, $username, $file->{filename});
	$_->unlink for io->catdir($self->plugin_directory,$username)->assert->all;
	binmode($fh);
	$newfile->assert->print(<$fh>);
	$newfile->close();
	$self->make_thumbnail($newfile,
			      $self->config->user_photo_width,
			      $self->config->user_photo_height,
			     );
    } else {
	$self->display_msg("Please specify a file to upload.");
    }
}

# From Kwiki::Attachments
sub make_thumbnail {
   use File::Basename;

   my ($file,$width,$height) = @_;
   my ($fname, $fpath, $ftype) = fileparse($file, qr(\..*$));
   my $thumb = io->catfile($fpath, "thumb$ftype");
   if (eval { require Imager }) {
      my $found = 0;
      if ($ftype =~ /jpg/i) {
         $found = 1;
      } else {
         for (keys %Imager::format) {
            if ($ftype =~ /$_/oi) {
               $found = 1;
               last;
            }
         }
      }
      if ($found) {
         my $image = Imager->new;
         return unless ref($image);
         $image->read(file=>$file);
         my $thumb_img = $image->scale(xpixels=>$width,ypixels=>$height);
         $thumb_img->write(file=>$thumb);
      }
   } elsif (eval { require Image::Magick }) {
      my $image = Image::Magick->new;
      return unless ref($image);
      if (!$image->Read($file)) {
         if (!$image->Scale(geometry=>"${width}x${height}")) {
            if (!$image->Contrast(sharpen=>"true")) {
               $image->Write($thumb);
            }
         }
      }
   }
}

package Kwiki::UserPhoto::CGI;
use base 'Kwiki::CGI';

cgi 'run_mode';
cgi 'uploaded_file' => qw(-upload);

package Kwiki::UserPhoto;

__DATA__

=head1 NAME

  Kwiki::UserPhoto - User Photo Widget

=head1 SYNOPSIS

  % kwiki -install Kwiki::UserPhoto
  % kwiki -update

=head1 DESCRIPTION

This plugin provide each site user to have a photo uploaded, and displayed on
the widget pane.

=head1 COPYRIGHT

Copyright 2005 by Kang-min Liu <gugod@gugod.org>.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

See <http://www.perl.com/perl/misc/Artistic.html>

=cut

__config/user_photo.yaml__
user_photo_width: 128
user_photo_height: 128
user_photo_default: user_photo_default.jpg
__template/tt2/user_photo_content.html__
<div class="user_photo">
<p class="message">[% self.display_msg %]</p>
<form method="post" action="[% script_name %]" enctype="multipart/form-data">
<input type="hidden" name="action"   value="user_photo" />
<input type="hidden" name="run_mode" value="upload" />
<input type="file"   name="uploaded_file" />
<input type="submit" name="Upload"   value="Upload" />
</form>
</div>