Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 58 lines (53 sloc) 1.632 kb
c663920 @pajamian Fix incorrect license in headers GPL v2 -> GPL v2 "or later". Update…
pajamian authored
1 # Copyright 2005-2007 Interchange Development Group and others
2 #
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2 of the License, or
6 # (at your option) any later version. See the LICENSE file for details.
7 #
8 # $Id: imagedir.widget,v 1.7 2007-03-30 23:40:58 pajamian Exp $
506d4c7 @docelic * Add header and license information
docelic authored
9
4e9405e @perusionmike * Move several widgets outboard into code/Widget.
perusionmike authored
10 CodeDef imagedir Widget 1
d2c526c @perusionmike * Add descriptions to widgets
perusionmike authored
11 CodeDef imagedir Description Image listing
3de2e1d @perusionmike * Add ExtraMeta capability to UserTags.
perusionmike authored
12 CodeDef imagedir ExtraMeta <<EOM
13 {
14 _order => [ qw/ follow_symlinks / ],
15 follow_symlinks => {
16 widget => 'yesno',
17 label => 'Follow Symlinks',
18 help => 'Set to yes if you want to list all files, even following symbolic links',
19 },
20 }
21 EOM
22
4e9405e @perusionmike * Move several widgets outboard into code/Widget.
perusionmike authored
23 CodeDef imagedir Routine <<EOR
24 use File::Find;
25 sub {
26 my ($opt) = @_;
27 my $dir = delete $opt->{dir} || delete $opt->{outboard};
28 my $suf = delete $opt->{suffix} || delete $opt->{options};
29 return undef unless -d $dir;
30 #::logDebug("passed suf=$suf");
31 $suf = '\.(GIF|gif|JPG|JPEG|jpg|jpeg|png|PNG)'
32 unless $suf;
33
34 if($suf and $suf !~ /[\.|]/) {
35 my @types = grep /\S/, split /[,\s\0]+/, $suf;
36 $suf = '\.(' . join("|", @types) . ')';
37 }
38
39 my @names;
40 my $regex;
41 eval {
65d0fda @perusionmike * Remove /o regex modifier so that differing suffixes will work in
perusionmike authored
42 $regex = qr{$suf$};
4e9405e @perusionmike * Move several widgets outboard into code/Widget.
perusionmike authored
43 };
44 return undef if $@;
45 my $wanted = sub {
46 return undef unless -f $_;
47 return undef unless $_ =~ $regex;
48 my $n = $File::Find::name;
49 $n =~ s:^$dir/?::;
50 push(@names, $n);
51 };
3de2e1d @perusionmike * Add ExtraMeta capability to UserTags.
perusionmike authored
52 find({ wanted => $wanted, follow => $opt->{follow_symlinks} }, $dir);
f0b673b Widget imagedir:
Ton Verhagen authored
53 $opt->{passed} = [ '=None', sort @names ];
4e9405e @perusionmike * Move several widgets outboard into code/Widget.
perusionmike authored
54 $opt->{type} = delete $opt->{variant} || 'combo';
55 return Vend::Form::display($opt);
56 }
57 EOR
Something went wrong with that request. Please try again.