view release on metacpan or  search on metacpan

stylesheets/extractimageinfo.xps  view on Meta::CPAN

#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
# 
# $Id: extractimageinfo.xps,v 1.10 2004/02/26 11:58:50 nik Exp $
 
# Check the cache directory for each image.  If we've got cached meta data
# for the image, and it's valid, then do nothing.  Otherwise, extract the
# data from the image and store it in the image's cache directory.

use strict;

use File::Path;
use Image::Info qw(image_info);
use Data::Dumper;
use RDF::Core;
use RDF::Core::Storage::Memory;
use RDF::Core::Model;
use RDF::Core::Resource;
use RDF::Core::Literal;
use RDF::Core::Statement;
use RDF::Core::Model::Serializer;

my $cache_dir = $r->dir_config('GalleryCache');

my($path, $filename, $uri, $cache_path, $imagemodtime, $metafile);

foreach my $image (findnodes('//image')) {
    $path = findvalue('dirpath', $image);
    $filename = findvalue('filename', $image);

    $uri = join('/', 
        map { findvalue('text()', $_) } 
              findnodes('uri/component/u', $image));

    $imagemodtime = findvalue('modified', $image)->value();
    
    $cache_path = "$cache_dir/$path/$filename";

    if(! -d $cache_path) {
#        $r->log_error("Need to make $cache_path");
        mkpath($cache_path);
    }

    $metafile = "$cache_path/imageinfo.rdf";

#    $r->log_error("metafile: $metafile");
#    my $f_meta = -f $metafile;
#    my $z_meta = -z $metafile;
#    my $s_meta = (stat($metafile))[9];

#    $r->log_error("f: $f_meta, z: $z_meta, mod: $imagemodtime, s: $s_meta");

    if(! -f $metafile || -z $metafile 
       || ($imagemodtime > (stat($metafile))[9])) {

#        $r->log_error("Generating $metafile");
        my $info = {};
        $info->{imageinfo} = image_info("$path/$filename");

        if(! $info->{error}) {
            # Work out the width/height ratio, and calculate
            # what the generated thumbnail dimensions will be
            my($w, $h) = ($info->{imageinfo}{width}, 
		          $info->{imageinfo}{height});
            my $larger = $w > $h ? $w : $h;
            $info->{thumbs}{thumb} = [];
            foreach my $size (split(/ +/, $r->dir_config('GallerySizes'))) {
                next if $size eq 'full';
                my $sf = $size / $larger;
                push @{$info->{thumbs}{thumb}}, 
                    { filename => "$size.jpg",
                             width => int($w * $sf),
                             height => int($h * $sf),
                             size => $size,
                    };
            }

#            $r->log_error('Extracted the image info');

	    # Sanitise the data in $info->{imageinfo}
            foreach (keys %{$info->{imageinfo}}) {
                # Keys that start 'App' seem to more trouble than they're 
		# worth, containing all sorts of odd crud.  Just delete them.
                delete $info->{imageinfo}{$_} and next
                       if $_ =~ /^App/;

                # Delete keys which contain non-printable data
                delete $info->{imageinfo}{$_} and next 
                       if $info->{imageinfo}{$_} =~ /[^[:print:]]/;

                # Delete keys that are ARRAY or HASH refs, they don't 
		# get serialised properly
                delete $info->{imageinfo}{$_} and next 
                       if ref($info->{imageinfo}{$_}) eq 'ARRAY'
                       or ref($info->{imageinfo}{$_}) eq 'HASH';

                # The value might be an object that knows how to stringify
		# itself.  Give it the chance to do so.
                $info->{imageinfo}{$_} = 
                       "$info->{imageinfo}{$_}";
            }
#            $r->log_error(Dumper($info));

            open(F, "> $metafile") or die;
            my $stor = new RDF::Core::Storage::Memory;
            my $model = new RDF::Core::Model(Storage => $stor);
            my $subject = new RDF::Core::Resource("/$uri/$filename");
	    my $predicate;
	    my $object;
	    my $statement;

            my($inf, $ns);

	    my %ns = ( image_info => 'http://www.cpan.org/authors/id/G/GA/GAAS/#',