home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / img-list.pl < prev    next >
Text File  |  2009-11-06  |  3KB  |  75 lines
  1. # FILE: img-list.pl
  2. # DESCRIPTION: User Interface list of images in "clipart" directory
  3. # NOTE: See http://support.discusware.com/center/resources/custom/imglist.html
  4. #-------------------------------------------------------------------------------
  5. # DISCUS COPYRIGHT NOTICE
  6. #
  7. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  8. # The use of Discus is governed by the Discus License Agreement which is
  9. # available from the Discus WWW site at:
  10. #    http://www.discusware.com/discus/license
  11. #
  12. # Pursuant to the Discus License Agreement, this copyright notice may not be
  13. # removed or altered in any way.
  14. #-------------------------------------------------------------------------------
  15.  
  16. use strict;
  17. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  18.  
  19. ###
  20. ### image_lister_control
  21. ###
  22. ### Generates a listing of the images found in the clipart directory
  23. ###
  24.  
  25. sub image_lister_control {
  26.     my $FORMref = defined $_[0] ? $_[0] : parse_form($ENV{'QUERY_STRING'}, $ENV{'CONTENT_LENGTH'});
  27.     my $cookie_str = $_[1];
  28.     dreq("template");
  29.     my $subst = {};
  30.     my $dir = defined $FORMref->{dir} ? $FORMref->{dir} : "clipart";
  31.     $dir =~ s/\W//g;
  32.     error_message("Directory Search Error", "Directory [$dir] cannot be searched!", 0, 1) if $dir eq "messages";
  33.     error_message("Directory Search Error", "Directory [$dir] cannot be searched!", 0, 1) if $dir eq "";
  34.     my $rdir = join("/", $DCONF->{html_dir}, $dir);
  35.     error_message("Directory Search Error", "Directory [$rdir] does not exist!", 0, 1) if ! -e $rdir;
  36.     error_message("Directory Search Error", "Directory [$rdir] is not a directory!", 0, 1) if ! -d $rdir;
  37.     $subst->{general}->{image_url} = join("/", $DCONF->{html_url}, $dir);
  38.     my $tag = defined $FORMref->{tagname} ? $FORMref->{tagname} : read_language()->{ILCLIPTAG};
  39.     $tag =~ s/<.*?>//g;
  40.     error_message("Illegal Tag Error", "Cannot use the tag you specified!", 0, 1) if $tag !~ /\S/;
  41.     $subst->{general}->{clip_tag} = $tag;
  42.     my $reg_exp = "(.*)";
  43.     $reg_exp = join("", "^", quotemeta($FORMref->{filterbegin}), $reg_exp) if $FORMref->{filterbegin};
  44.     $reg_exp = join("", $reg_exp, quotemeta($FORMref->{filterend}), '$') if $FORMref->{filterend};
  45.     $reg_exp .= "\\.gif\$" if ! $FORMref->{filterend};
  46.     $subst->{general}->{regexp} = $reg_exp;
  47.     my $shown = {};
  48.     if ($FORMref->{show}) {
  49.         foreach my $x (split(/,/, $FORMref->{show})) {
  50.             $shown->{$x} = 1;
  51.         }
  52.     }
  53.     $subst->{general}->{pagetitle} = defined $FORMref->{title} ? $FORMref->{title} : read_language()->{ILTITLE};
  54.     my @img = ();
  55.     if (opendir(DIR, $rdir)) {
  56.         while (my $d = readdir(DIR)) {
  57.             my $file = join("/", $rdir, $d);
  58.             next if ! -f $file;
  59.             next if $d !~ /$reg_exp/;
  60.             next if scalar(keys(%{ $shown })) && ! $shown->{$d};
  61.             next if $d eq "your_image.gif";
  62.             next if $d eq "board_logo.gif";
  63.             my $i = $d;
  64.             $i =~ s/\.(\w+)$// if ! $FORMref->{save_ext};
  65.             push @img, { filename => $d, shownfile => $i };
  66.         }
  67.     }
  68.     @img = sort { lc($a->{filename}) cmp lc($b->{filename}) } @img;
  69.     $subst->{images} = \@img;
  70.     $subst->{general}->{popup} = $FORMref->{popup};
  71.     screen_out("img-list", $subst, $cookie_str);
  72. }
  73.  
  74. 1;
  75.