Image::Magick results from the CPAN

Apache-UpnpImgBrowser

# Apache::UpnpImgBrowser

#
# James Pavlick, 2007
# mod_perl module for browsing directories of images stored on a Upnp device
#

=head1 NAME

Apache::UpnpImgBrowser

=head1 SYNOPSIS

Add the following to your httpd.conf and restart. Then point your browser to
http://yoursite/photos


  <Location /photos>
    AllowOverride None
    #Options -Indexes -Includes -FollowSymLinks
    Order allow,deny
    Allow from all

    SetHandler perl-script
    PerlHandler Apache::UpnpImgBrowser
    PerlSetVar Basedir Photos/Folder
    PerlSetVar Rows 10
    PerlSetVar Cols 5
    PerlSetVar Thumb-size 50x20
    PerlSetVar Show-names 0
    PerlSetVar Hide-dirs 1
    PerlSetVar Filter  vacation
  </Location>

=head1 DESCRIPTION

I<Apache::UpnpImgBroswer> is a mod_perl application for displaying photos
hosted on a UPnPAV compliant Media Server. I<Apache::UpnpImgBroswer> will
automatically discover all these types of devices on your network.

=head1 CAVEATS

=over 2

=item B<*> Thumbnails only work with TwonkyVision

=item B<*> Lots of work still to do

=cut


package Apache::UpnpImgBrowser;
use strict;
use Apache2;
use Apache::RequestRec;
use Apache::RequestIO;
use Apache::Const qw(:common HTTP_OK);
use Apache::Log;
use APR::Const qw(:filetype);
use APR::Finfo;
use Image::Magick ();
use DirHandle ();
use FileHandle ();
use File::Basename qw(fileparse);
use Net::UPnP::ControlPoint;
use Net::UPnP::AV::MediaServer;
use SOAP::Lite maptype => {}; 
use XML::Simple;
use Data::Dumper;
use POSIX qw(strftime);
use Cache::FileCache;
use URI::Escape;
use LWP::Simple;



use vars qw(%gOptions @gOutput $gOutputStarted $gCp @gDeviceList $gLastDir $cache $VERSION);

$VERSION = 0.01;

%gOptions = (
	     'thumb-size' => '100x75',    # set thumbnail size
             'force'      => 0,           # always rebuild thumbnails
             'rows'       => 5,           # rows to display
             'cols'       => 4,           # columns to display
             'show-names' => 0,           # show thumbnail names
             'hide-dirs'  => 0,           # hide the photo directories list
             'filter'     => '.*',        # display only directories that match 
             'basedir'    => 'Photos',    # Base directory of the UPNP server
	    );

$cache = new Cache::FileCache( { 'namespace' => 'UpnpImgBrowser',
                                 'default_expires_in' => 600 } );


sub handler {
    my($r) = shift;

    $gCp =  $cache->get('cp');
    @gDeviceList = $cache->get('device');
 
    if (! defined $gCp) {
        $gCp = Net::UPnP::ControlPoint->new();
        $cache->set('cp', $gCp);
    }

    unless (grep ref $_ eq 'Net::UPnP::Device', @gDeviceList) { 
        @gDeviceList = (upnpInitDevice($r));
        $cache->set('device', @gDeviceList);
    }

    # store output in this array
    @gOutput = ();

    $gOutputStarted = 0;

    # set config values
    my $val = '';
    $gOptions{'thumb-size'} = $val if($val = $r->dir_config('Thumb-size'));
    $gOptions{'force'}      = $val if($val = $r->dir_config('Force'));  
    $gOptions{'rows'}       = $val if($val = $r->dir_config('Rows'));

UpnpImgBrowser.pm view on Meta::CPAN

              qq|          <select onChange="document.location='./?dir=$dir&dev=$dev&page=' + this.options[this.selectedIndex].value">\n|
             );
 
       for(my $y = 0; $y <= int((@filelist - 1)/$perpage); $y++) {
          my $pagenum = $y + 1;

          ($pagenum == $page) ?
              output(qq|              <option value="$pagenum" selected>page $pagenum\n|):
              output(qq|              <option value="$pagenum">page $pagenum\n|);
       }

       output(
              qq|          </select><br>\n|,
              qq|          <font size="-1"><i>Total: </i>|, scalar @filelist, qq| images</font>\n|,
              qq|          </form>\n|,
              qq|        </td>\n|
             );
    }
    
    # next page
    if( $page * $perpage < @filelist) {
       my $pagenum = $page + 1; 
       output(qq|        <td width=100 align="center"><a href="./?dir=$dir&dev=$dev&page=$pagenum">[next]</A></TD>\n|);

    } else {
       output(qq|        <td width=100>&nbsp;</td>\n|);
    }


    output(
           "      </tr>\n",
           "    </table>\n",
           "  </td></tr>\n",
           "</table>\n",
           "</center>\n",
	   "</body>\n",
           "</html>\n"
          );

}



# showThumbFile
#
#
sub showThumbFile {
    my $r = shift || return;

    my %mimeType = 
       (jpg => 'image/jpeg', gif => 'image/gif', png => 'image/png');
    my ($name, $path, $ext) = fileparse($r->filename, qr{\.\w*$});
    my($w, $h) = split('x', $gOptions{'thumb-size'});

    $name =~ s/^\.//g;
    $path =~ s/\/$//g;
    $ext =~ s/^\.//g;
 
    (my $imgName = $name) =~ s/-thumb$//i;
    my($thumbName) = "$name.$ext";
    my($Img) = Image::Magick->new();
    my($tw, $th) = (0, 0);

    if(-f "$path/$thumbName") {
        ($tw, $th) = $Img->Ping("$path/$thumbName");
    }

    # build the thumbnail if it doesn't exist
    if( ($w != $tw && $h != $th) || $gOptions{'force'} ) {
        $Img->Read("$path/../$imgName.$ext");
        $Img->Resize(geometry=>"$gOptions{'thumb-size'}"); 
        $Img->Write("$path/$thumbName");
    }

    my $Fh = FileHandle->new();
    $Fh->open("$path/$thumbName") || die("Can't open image file $path/$thumbName");

    $r->content_type($mimeType{lc $ext});
    output(<$Fh>);

    undef $Img; 
    $Fh->close();
}



# showImgDetail
#
#
#
sub showImgDetail {
    my($r) = shift;

    my(%in) = map { my($key, $val) = split('=', $_); $key => $val } 
                  (split('&', $r->args));

    my $image = $in{image};
    my $page = $in{page} || 1;
    my $dir = $in{dir};
    my $dev = uri_unescape($in{dev}) || $gDeviceList[0]->getudn;
    $dev =~ s/\+/ /g;

 
    # only rotate up to 360 degrees 
    if($in{'rot'} >= 360) { $in{'rot'} -= 360 };

    # only allow scaling to 25% and 200% of image size
    if($in{'scale'} < -75) { $in{'scale'} = -75 };
    if($in{'scale'} > 100) { $in{'scale'} = 100 };

    my $scale = $in{'scale'} + 100;

    my $rotText = ($in{'rot'}) ? "(Rotated: $in{'rot'}&deg;)" : ''; 
    my $scaleText = ($in{'scale'}) ? "(Scaled: $scale%)" : '';
 
    $r->content_type("text/html"); 
    output(
              "<html>\n",
              "<head>\n",
              "  <title>Image</title>\n",
              "</head>\n",

UpnpImgBrowser.pm view on Meta::CPAN


    return unless $item;

    my @res = sort {$a->{size} <=> $b->{size}} @{$item->{'res'}};
    $res[0];
}



# proxyRequest
#
#
sub proxyRequest {
    my($r) = shift;

    my(%in) = map { my($key, $val) = split('=', $_); $key => $val }                             (split('&', $r->args));
    my $target = $in{target};
    my $dev = $in{dev};

    my($device) = (grep $_->getudn eq $dev, @gDeviceList)[0];
    return undef unless ref $device eq 'Net::UPnP::Device';

    return undef unless $target;

    $device->getlocation =~ m|(http://[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+\:[0-9]+)|;
    my $baseurl = $1;
    my $content = get(join('/', $baseurl,$target));

    output($content);
}


# processImg
#
#
#
sub processImg {
    my($r) = shift;

    my(%in) = map { my($key, $val) = split('=', $_); $key => $val }                             (split('&', $r->args));

    my($imgfile) = $r->filename;
    my ($name, $path, $ext) = fileparse($imgfile, qr{\..*});

    $path =~ s/\/$//g;
    $ext =~ s/^\.//g;

    # only rotate up to 360 degrees
    if($in{'rot'} >= 360) { $in{'rot'} -= 360 };


    # only allow scaling to 25% and 200% of image size
    if($in{'scale'} < -75) { $in{'scale'} = -75 };
    if($in{'scale'} > 100) { $in{'scale'} = 100 };

    if(%in) {
       my($tmpfile) = "/tmp/$name." . time . ".$$.$ext";
      
       my $scale = $in{'scale'} + 100; 
 
       my($Img) = Image::Magick->new;
       $Img->Read($imgfile);
       $Img->Rotate(degrees=>$in{'rot'}) if($in{'rot'});
       $Img->Scale(geometry=>"${scale}%x${scale}%") if($in{'scale'});
       $Img->Write("$tmpfile");

       my($fh)  = FileHandle->new("$tmpfile");

       unless($fh) {
          $r->log_error("Couldn't open file '$tmpfile'");
          return SERVER_ERROR;
       }
 
       local $/;
       output(<$fh>);
       $fh->close;

       unlink $tmpfile;

    } else {
       return DECLINED;
    }

}




# getParentId
#
#
sub getParentId {
    my($r, $dir) = @_;

    my $retval;

    if($dir =~ /\$/) {
        my @tmp = split('\$', $dir);
        pop @tmp;
        $retval = join('$', @tmp);
    } else {
        $retval = 0;
    }

    $retval;
}



# getMetadata
#
#
sub getMetadata {
    my($r, $id, $dev) = @_;

    my($retval);

    my($device) = (grep $_->getudn eq $dev, @gDeviceList)[0];
    return undef unless ref $device eq 'Net::UPnP::Device';

    $retval = upnpGetMetadata($r, $device, $id);

( run in 0.608 second using v1.01-cache-2.11-cpan-6aa56a78535 )