/usr/lib/perl5/Prima/Image/tiff.pm is in libprima-perl 1.28-1.1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | #
# Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
# 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.
#
# Created by Dmitry Karasik <dk@plab.ku.dk>
# $Id: tiff.pm,v 1.2 2005/10/13 17:22:52 dk Exp $
#
use strict;
use Prima;
use Prima::VB::VBLoader;
package Prima::Image::tiff;
sub on_change
{
my ( $self, $codec, $image) = @_;
$self-> {image} = $image;
$self-> {image}-> {extras} ||= {};
my $e = $image-> {extras};
for ( @{$self-> TextSelector-> items}) {
if ( exists $e->{$_}) {
$self-> {TextFields}->{$_} = $e->{$_};
} else {
$self-> {TextFields}->{$_} = $codec-> {saveInput}-> {$_};
}
}
for ( qw( Compression ResolutionUnit XResolution YResolution)) {
$self-> bring($_)-> text( exists $e-> {$_} ? $e-> {$_} : $codec-> {saveInput}->{$_});
}
$self-> TextField-> text( $self-> {TextFields}-> {$self-> TextSelector-> text});
}
sub OK_Click
{
my $self = $_[0]-> owner;
$self-> {image}-> {extras} ||= {};
my $e = $self-> {image}-> {extras};
$self-> {TextFields}->{$self-> TextSelector-> text} = $self-> TextField-> text;
for ( @{$self-> TextSelector-> items}) {
if ( exists($self-> {TextFields}->{$_}) && length($self-> {TextFields}->{$_})) {
$e-> {$_} = $self-> {TextFields}->{$_};
} else {
delete $e->{$_};
}
}
$e-> {Compression} = $self-> Compression-> text;
$e-> {ResolutionUnit} = $self-> ResolutionUnit-> text;
if ( $e-> {ResolutionUnit} eq 'none') {
delete $e-> {XResolution};
delete $e-> {YResolution};
delete $e-> {ResolutionUnit};
} else {
$e-> {XResolution} = $self-> XResolution-> value;
$e-> {YResolution} = $self-> YResolution-> value;
}
delete $self-> {image};
}
sub Cancel_Click
{
my $self = $_[0]-> owner;
delete $self-> {image};
}
sub save_dialog
{
my $codec = $_[1];
return Prima::VBLoad( 'Prima::Image::tiff.fm',
Form1 => {
visible => 0,
onChange => \&on_change,
},
Compression => { items => [ qw(NONE),
map { m/^Compression-(.*)$/ ? $1 : () } @{$codec-> {featuresSupported}} ]},
OK => { onClick => \&OK_Click },
Cancel => { onClick => \&Cancel_Click },
);
}
1;
|