File:  [LON-CAPA] / loncom / auth / localstudentphoto.pm
Revision 1.5: download - view: text, annotated - select for diffs
Mon Nov 10 13:20:24 2008 UTC (15 years, 6 months ago) by jms
Branches: MAIN
CVS tags: HEAD
POD documentation changes

    1: # The LON-CAPA dummy student photo fetch mechnism
    2: #
    3: # $Id: localstudentphoto.pm,v 1.5 2008/11/10 13:20:24 jms Exp $
    4: #
    5: # Copyright Michigan State University Board of Trustees
    6: #
    7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    8: #
    9: # LON-CAPA is free software; you can redistribute it and/or modify
   10: # it under the terms of the GNU General Public License as published by
   11: # the Free Software Foundation; either version 2 of the License, or
   12: # (at your option) any later version.
   13: #
   14: # LON-CAPA is distributed in the hope that it will be useful,
   15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17: # GNU General Public License for more details.
   18: #
   19: # You should have received a copy of the GNU General Public License
   20: # along with LON-CAPA; if not, write to the Free Software
   21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22: #
   23: # /home/httpd/html/adm/gpl.txt
   24: #
   25: # http://www.lon-capa.org/
   26: #
   27: # 8/24 Guy Albertelli
   28: 
   29: 
   30: 
   31: 
   32: package localstudentphoto;
   33: use lib '/home/httpd/lib/perl/';
   34: use LONCAPA::Configuration;
   35: 
   36: sub fetch {
   37:     my ($domain,$user,$pid,$response)=@_;
   38:     my $temptxt = '';
   39:     unless (ref($response)) {
   40:         $response = \$temptxt;
   41:     }
   42:     if ($udom eq '' || $uname eq '') {
   43:         $$response = 'nouser';
   44:         return '';
   45:     }
   46:     return &main::propath($domain,$user).
   47: 	'/userfiles/internal/studentphoto.jpg';
   48: }
   49: 
   50: sub fetch_thumbnail {
   51:     my ($udom,$uname) = @_;
   52:     if ($udom eq '' || $uname eq '') {
   53:         return '';
   54:     }
   55:     my $userdir=&main::propath($udom,$uname);
   56:     my $filepath = '/userfiles/internal/studentphoto.jpg';
   57:     my $thumbnail = '/userfiles/internal/studentphoto_tn.gif';
   58:     my $source =  "$userdir/$filepath";
   59:     my $dest = "$userdir/$thumbnail";
   60:     if (-e $dest) {
   61:         return $dest;
   62:     } else {
   63:         if (!-e $source) {
   64:             my $file = &fetch($udom,$uname);
   65:         }
   66:         if (-e $source) {
   67:             my ($fullsize,$thumbsize)=&localstudentphoto::thumbsettings($udom);
   68:             if ($fullsize && $thumbsize) {
   69:                 system("convert -size $fullsize $source -thumbnail $thumbsize $dest");
   70:             }
   71:             if (-e $dest) {
   72:                 return $dest;
   73:             }
   74:         }
   75:     }
   76:     return '';
   77: }   
   78: 
   79: sub thumbsettings {
   80:     my ($dom) = @_;
   81:     my $fullsize = '240x240';
   82:     my $thumbsize = '40x40';
   83:     return ($fullsize,$thumbsize);
   84: }
   85:                                                                                 
   86: sub AUTOLOAD {
   87:     our $AUTOLOAD;
   88:     return '';
   89: }
   90: 
   91: 1;
   92: __END__
   93: 
   94: =pod
   95: 
   96: =head1 NAME
   97: 
   98: AUTOLOAD
   99: 
  100: =head1 SYNOPSIS
  101: 
  102: Incoming data: none
  103: Returns ''
  104: 
  105: =head1 OVERVIEW
  106: 
  107: Prevents errors when undefined subroutines are called in this package. 
  108: Will allow new routines added in the future to be called from lond etc.
  109: without the need for customized versions of local*.pm packages to be
  110: modified to include the new subroutines immediately.
  111: 
  112: See I<"Programming Perl"> 3rd ed. pp 296-298.
  113: 
  114: =cut
  115: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>