flash in the image manager
authorTony Cook <tony@develop-help.com>
Wed, 2 Dec 2009 05:20:54 +0000 (05:20 +0000)
committertony <tony@45cb6cf1-00bc-42d2-bb5a-07f51df49f94>
Wed, 2 Dec 2009 05:20:54 +0000 (05:20 +0000)
33 files changed:
MANIFEST
schema/bse.sql
site/cgi-bin/admin/imageclean.pl
site/cgi-bin/bse.cfg
site/cgi-bin/modules/Article.pm
site/cgi-bin/modules/BSE/DB/Mysql.pm
site/cgi-bin/modules/BSE/Edit/Article.pm
site/cgi-bin/modules/BSE/Edit/Site.pm
site/cgi-bin/modules/BSE/ImageHandler/Base.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/ImageHandler/Flash.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/ImageHandler/Img.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/StorageMgr/Images.pm
site/cgi-bin/modules/BSE/TB/Image.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TB/Images.pm [new file with mode: 0644]
site/cgi-bin/modules/BSE/TagFormats.pm
site/cgi-bin/modules/BSE/ThumbLow.pm
site/cgi-bin/modules/BSE/UI/AdminShop.pm
site/cgi-bin/modules/BSE/UI/Image.pm
site/cgi-bin/modules/BSE/UI/Thumb.pm
site/cgi-bin/modules/BSE/Util/Thumb.pm
site/cgi-bin/modules/Generate.pm
site/cgi-bin/modules/Generate/Article.pm
site/cgi-bin/modules/Generate/Product.pm
site/cgi-bin/modules/Image.pm [deleted file]
site/cgi-bin/modules/Images.pm [deleted file]
site/htdocs/css/admin.css
site/htdocs/css/style-main.css
site/templates/admin/article_img.tmpl
site/templates/admin/edit_product.tmpl
site/templates/admin/product_menu.tmpl
site/util/mysql.str
t/t00smoke.t
t/t20gen.t

index 6619bcf..61bdbd7 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -87,6 +87,9 @@ site/cgi-bin/modules/BSE/Generate/Seminar.pm
 # site/cgi-bin/modules/BSE/FileEditor.pm
 site/cgi-bin/modules/BSE/Handler/Base.pm
 site/cgi-bin/modules/BSE/Handler/Page.pm
+site/cgi-bin/modules/BSE/ImageHandler/Base.pm
+site/cgi-bin/modules/BSE/ImageHandler/Flash.pm
+site/cgi-bin/modules/BSE/ImageHandler/Img.pm
 site/cgi-bin/modules/BSE/ImportSourceBase.pm
 site/cgi-bin/modules/BSE/ImportSourceXLS.pm
 site/cgi-bin/modules/BSE/ImportTargetArticle.pm
@@ -142,6 +145,8 @@ site/cgi-bin/modules/BSE/TB/BackgroundTask.pm
 site/cgi-bin/modules/BSE/TB/BackgroundTasks.pm
 site/cgi-bin/modules/BSE/TB/FileAccessLog.pm
 site/cgi-bin/modules/BSE/TB/FileAccessLogEntry.pm
+site/cgi-bin/modules/BSE/TB/Image.pm
+site/cgi-bin/modules/BSE/TB/Images.pm
 site/cgi-bin/modules/BSE/TB/Location.pm
 site/cgi-bin/modules/BSE/TB/Locations.pm
 site/cgi-bin/modules/BSE/TB/Order.pm
@@ -239,8 +244,6 @@ site/cgi-bin/modules/Generate/Article.pm
 site/cgi-bin/modules/Generate/Catalog.pm
 site/cgi-bin/modules/Generate/Product.pm
 site/cgi-bin/modules/Generate/Subscription.pm
-site/cgi-bin/modules/Image.pm
-site/cgi-bin/modules/Images.pm
 site/cgi-bin/modules/OtherParent.pm
 site/cgi-bin/modules/OtherParents.pm
 site/cgi-bin/modules/Product.pm
index 9a7b2fd..3faf112 100644 (file)
@@ -145,6 +145,7 @@ CREATE TABLE image (
   name varchar(255) default '' not null,
   storage varchar(20) not null default 'local',
   src varchar(255) not null default '',
+  ftype varchar(20) not null default 'img',
 
   PRIMARY KEY (id)
 );
index f4e513b..924d63d 100755 (executable)
@@ -2,12 +2,12 @@
 use strict;
 use FindBin;
 use lib "$FindBin::Bin/../modules";
-use Images;
+use BSE::TB::Images;
 use Articles;
 use Constants qw($IMAGEDIR);
 
 my %articleIds = ( -1 => 1 );
-my $images = Images->new;
+my $images = BSE::TB::Images->new;
 my @images = $images->all;
 
 ++$|;
@@ -36,7 +36,7 @@ for my $image (@images) {
 
 print "\n\nRebuilding image list and indexing\n";
 # rebuild the images list
-$images = Images->new;
+$images = BSE::TB::Images->new;
 @images= $images->all;
 
 my %names = map { $_->{image}, $_->{id} } @images;
index 782550d..0fe093b 100644 (file)
@@ -429,3 +429,6 @@ stylesheet=email/email.css,text/css,1
 [targets]
 tellafriend=/cgi-bin/nuser.pl/tellafriend/TARGET
 tellafriend_n=/cgi-bin/nuser.pl/tellafriend
+
+[thumb geometries]
+editor=scale(200x200)
index 12cc4cf..ffd8ee2 100644 (file)
@@ -119,8 +119,8 @@ sub all_visible_catalogs {
 
 sub images {
   my ($self) = @_;
-  require Images;
-  Images->getBy(articleId=>$self->{id});
+  require BSE::TB::Images;
+  BSE::TB::Images->getBy(articleId=>$self->{id});
 }
 
 sub children {
index bbfdf9d..f7cfa2a 100644 (file)
@@ -73,8 +73,8 @@ EOS
 
    Images => 'select * from image',
    replaceImage =>
-     'replace image values (?,?,?,?,?,?,?,?,?,?,?)',
-   addImage => 'insert image values(null, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)',
+     'replace image values (?,?,?,?,?,?,?,?,?,?,?,?)',
+   addImage => 'insert image values(null, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)',
    deleteImage => 'delete from image where id = ?',
    getImageByArticleId => 'select * from image where articleId = ? order by displayOrder',
    getImageByPkey => 'select * from image where id = ?',
index d99e7d5..7f7f90e 100644 (file)
@@ -1031,20 +1031,41 @@ sub tag_thumbimage {
   my $filename = "$imagedir/$$current_image->{image}";
   -e $filename or return "** image file missing **";
 
-  my $geometry = $cfg->entry('thumb geometries', $args, 'scale(200x200)');
+  defined $args && $args =~ /\S/
+    or $args = "editor";
 
   my $image = $$current_image;
-  my ($width, $height) = $thumbs_obj->thumb_dimensions_sized
-    ($geometry, @$image{qw/width height/});
+  return $image->thumb
+    (
+     geo => $args,
+     cfg => $cfg,
+    );
+}
 
+sub tag_image {
+  my ($self, $cfg, $rcurrent, $args) = @_;
 
-  my ($uri, $alt);
-  $alt = "thumbnail of ".$$current_image->{alt};
-  $uri = "$ENV{SCRIPT_NAME}?a_thumb=1&id=$$current_image->{articleId}&im=$$current_image->{id}&w=$width&h=$height";
+  my $im = $$rcurrent
+    or return '';
 
-  $alt = escape_html($alt);
-  $uri = escape_html($uri);
-  return qq!<img src="$uri" width="$width" height="$height" alt="$alt" border="0" />!;
+  my ($align, $rest) = split ' ', $args, 2;
+
+  if ($align && exists $im->{$align}) {
+    if ($align eq 'src') {
+      return escape_html($im->image_url($self->{cfg}));
+    }
+    else {
+      return escape_html($im->{$align});
+    }
+  }
+  else {
+    return $im->formatted
+      (
+       cfg => $cfg,
+       align => $align,
+       extras => $rest,
+      );
+  }
 }
 
 sub low_edit_tags {
@@ -1105,6 +1126,7 @@ sub low_edit_tags {
      $it->make_iterator
      ([ \&iter_get_images, $self, $article ], 'image', 'images', \@images, 
       \$image_index, undef, \$current_image),
+     image => [ tag_image => $self, $cfg, \$current_image ],
      thumbimage => [ \&tag_thumbimage, $cfg, $thumbs_obj, \$current_image ],
      ifThumbs => defined($thumbs_obj),
      ifCanThumbs => defined($thumbs_obj_real),
@@ -2575,7 +2597,7 @@ sub do_add_image {
   use Image::Size;
 
 
-  my($width,$height) = imgsize("$imagedir/$filename");
+  my($width,$height, $type) = imgsize("$imagedir/$filename");
 
   my $alt = $opts{alt};
   defined $alt or $alt = '';
@@ -2593,11 +2615,15 @@ sub do_add_image {
      name => $imageref,
      storage => 'local',
      src => '/images/' . $filename,
+     ftype => "img",
     );
-  require Images;
-  my @cols = Image->columns;
+  if ($type eq 'CWS' || $type eq 'SWF') {
+    $image{ftype} = "flash";
+  }
+  require BSE::TB::Images;
+  my @cols = BSE::TB::Image->columns;
   shift @cols;
-  my $imageobj = Images->add(@image{@cols});
+  my $imageobj = BSE::TB::Images->add(@image{@cols});
 
   my $storage = $opts{storage};
   defined $storage or $storage = 'local';
index 827c8ec..f816231 100644 (file)
@@ -42,9 +42,9 @@ sub article_actions {
 sub get_images {
   my ($self, $article) = @_;
 
-  require Images;
+  require BSE::TB::Images;
 
-  Images->getBy(articleId => -1);
+  return BSE::TB::Images->getBy(articleId => -1);
 }
 
 sub get_files {
diff --git a/site/cgi-bin/modules/BSE/ImageHandler/Base.pm b/site/cgi-bin/modules/BSE/ImageHandler/Base.pm
new file mode 100644 (file)
index 0000000..e8d0317
--- /dev/null
@@ -0,0 +1,27 @@
+package BSE::ImageHandler::Base;
+use strict;
+use Carp qw(confess);
+
+sub new {
+  my ($class, %opts) = @_;
+
+  my $cfg = delete $opts{cfg}
+    or confess "Missing cfg option";
+
+  return bless
+    {
+     cfg => $cfg,
+    }, $class;
+}
+
+sub cfg {
+  $_[0]{cfg};
+}
+
+sub thumb {
+  my ($self, %opts) = @_;
+
+  return "* thumb not implemented for " . (ref $self || $self) . " *";
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/ImageHandler/Flash.pm b/site/cgi-bin/modules/BSE/ImageHandler/Flash.pm
new file mode 100644 (file)
index 0000000..69c4bc0
--- /dev/null
@@ -0,0 +1,215 @@
+package BSE::ImageHandler::Flash;
+use strict;
+use base 'BSE::ImageHandler::Base';
+use DevHelp::HTML;
+use Carp qw(confess);
+
+my @flash_opts = qw/quality wmode id play loop menu bgcolor flashvars class/;
+my %flash_defs =
+  (
+   quality => "high",
+   wmode => "opaque",
+  );
+
+# render tags needed to display the flash
+sub _render_low {
+  my ($self, $im, $image_url, $opts) = @_;
+
+  my $html = qq(<object classid="clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"\ncodebase="http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,40,0"\ntype="application/x-shockwave-flash"\nwidth="$im->{width}" height="$im->{height}");
+  my $class = delete $opts->{class};
+  defined $class and $html .= qq( class="$class");
+  my $id = delete $opts->{id};
+  defined $id and $html .= qq( id="$id");
+  $html .=">\n";
+  $html .= qq(<param name="movie" value="$image_url" />\n);
+  for my $opt (keys %$opts) {
+    $html .= qq(<param name="$opt" value=") 
+      . escape_html($opts->{$opt}) . qq(" />\n);
+  }
+  $html .= qq(<embed src="$image_url");
+  for my $opt (keys %$opts) {
+    $html .= qq( $opt=") . escape_html($opts->{$opt}) . '"';
+  }
+  defined $id and $html .= qq( name="$id");
+  $html .= qq( height="$im->{height}" width="$im->{width}");
+  $html .= q( type="application/x-shockwave-flash" pluginspage="http://www.macromedia.com/go/getflashplayer"></embed></object>);
+
+  return $html;
+}
+
+sub format {
+  my ($self, %opts) = @_;
+
+  my $im = delete $opts{image};
+  my $cfg = $self->cfg;
+  my $align = $opts{align} || '';
+  my $rest = delete $opts{extras};
+  defined $rest or $rest = '';
+
+  my $image_url = $im->image_url($cfg);
+
+  my $type = _flash_var($rest, "type");
+  my $section = defined $type ? "embedded $type flash" : "embeded flash";
+
+  my %flash_opts = %flash_defs;
+  for my $opt (@flash_opts) {
+    my $value = _flash_var($rest, $opt);
+    defined $value or $value = $cfg->entry($section, $opt);
+    defined $value and $flash_opts{$opt} = $value;
+  }
+
+  return $self->_render_low($im, $image_url, \%flash_opts);
+}
+
+sub _flash_var {
+  my ($str, $name) = @_;
+
+  if ($str =~ /\bflash:\Q$name\E=(["'])((?:\\"|\\'|\\\\|[^"'\\])*)\1/) {
+    return $1;
+  }
+  elsif ($str =~ /\bflash:\Q$name\E=(\S*)/) {
+    return $1;
+  }
+  return;
+}
+
+sub _make_thumb_hash {
+  my ($self, $geo_id, $im, $static) = @_;
+
+  my $cfg = $self->cfg;
+  my $debug = $cfg->entry('debug', 'thumbnails', 0);
+
+  $static ||= 0;
+
+  $debug
+    and print STDERR "_make_thumb_hash(..., $geo_id, $im->{src}, ..., $static)\n";
+
+  $geo_id =~ /^[\w,]+$/
+    or return ( undef, "* invalid geometry id *" );
+
+  my $geometry = $cfg->entry('thumb geometries', $geo_id)
+    or return ( undef, "* cannot find thumb geometry $geo_id *" );
+
+  my $thumbs_class = $cfg->entry('editor', 'thumbs_class')
+    or return ( undef, '* no thumbnail engine configured *' );
+
+  (my $thumbs_file = $thumbs_class . ".pm") =~ s!::!/!g;
+  require $thumbs_file;
+  my $thumbs = $thumbs_class->new($cfg);
+
+  $debug
+    and print STDERR "  Thumb class $thumbs_class\n";
+
+  my $error;
+  $thumbs->validate_geometry($geometry, \$error)
+    or return ( undef, "* invalid geometry string: $error *" );
+
+  my %im = map { $_ => $im->{$_} } $im->columns;
+
+  @im{qw/width height type original/} = 
+    $thumbs->thumb_dimensions_sized($geometry, @$im{qw/width height/});
+
+  # leave the source as the original SWF
+
+  return \%im;
+}
+
+sub thumb {
+  my ($self, %opts) = @_;
+
+  $DB::single=1;
+
+  my $geo_id = delete $opts{geo};
+  defined $geo_id
+    or confess "Missing geo parameter";
+  my $im = delete $opts{image}
+    or confess "Missing image parameter";
+  my $field = delete $opts{field} || '';
+  my $static = delete $opts{static} || 0;
+
+  my ($imwork, $error) = 
+    $self->_make_thumb_hash($geo_id, $im, $static);
+
+  $imwork
+    or return escape_html($error);
+
+  if ($field) {
+    my $value = $imwork->{$field};
+    defined $value or $value = '';
+    return escape_html($value);
+  }
+  else {
+    my $cfg = $self->cfg;
+    my %flash_opts = %flash_defs;
+    for my $opt (@flash_opts) {
+      my $value = $cfg->entry("flash thumbnail $geo_id", $opt);
+      defined $value or $value =  $cfg->entry("flash thumbnail", $opt);
+      defined $value and $flash_opts{$opt} = $value;
+    }
+
+    return $self->_render_low($imwork, $im->image_url($cfg), \%flash_opts);
+  }
+}
+
+sub inline {
+  my ($self, %opts) = @_;
+
+  my $image = delete $opts{image}
+    or confess "Missing image parameter";
+  my $align = delete $opts{align}
+    or confess "Missing align parameter";
+
+  my %flash_opts = 
+    (
+     %flash_defs,
+     class => "bse_flash_$align",
+    );
+  my $cfg = $self->cfg;
+  for my $opt (@flash_opts) {
+    my $value = $cfg->entry("flash inline", $opt);
+    defined $value and $flash_opts{$opt} = $value;
+  }
+
+  my $image_url = $image->image_url($self->{cfg});
+  return $self->_render_low
+    (
+     $image,
+     $image_url,
+     \%flash_opts,
+    );
+}
+
+1;
+
+=head1 NAME
+
+BSE::ImageHandler::Flash - handle "image" display for flash
+
+=head1 DESCRIPTION
+
+This module provides display rendering and limited thumbnail rendering
+for flash content in the image manager.
+
+For image[] and <:image ...:> tags, any value flash:I<name>=I<value>
+where I<name> is in the following will be used to set the
+corresponding value for the generated object/embed tags:
+
+=over
+
+=item *
+
+quality - Default "high",
+
+=item *
+
+wmode - default "opaque".
+
+=item *
+
+id - sets id for object, name for embed.  Default: not set.
+
+=item *
+
+play, loop, menu, bgcolor, flashvars.  Default: not set.
+
+=cut
diff --git a/site/cgi-bin/modules/BSE/ImageHandler/Img.pm b/site/cgi-bin/modules/BSE/ImageHandler/Img.pm
new file mode 100644 (file)
index 0000000..ea591b5
--- /dev/null
@@ -0,0 +1,183 @@
+package BSE::ImageHandler::Img;
+use strict;
+use base 'BSE::ImageHandler::Base';
+use Carp qw(confess);
+use DevHelp::HTML;
+
+sub thumb_base_url {
+  '/cgi-bin/thumb.pl';
+}
+
+sub format {
+  my ($self, %opts) = @_;
+
+  my $im = delete $opts{image}
+    or confess "Missing image parameter";
+
+  my $cfg = $self->cfg;
+  my $align = delete $opts{align} || '';
+  my $rest = delete $opts{extras} || '';
+
+  my $image_url = $im->image_url($cfg);
+  my $html = qq!<img src="$image_url" width="$im->{width}"!
+    . qq! height="$im->{height}" alt="! . escape_html($im->{alt})
+      . qq!"!;
+  $html .= qq! align="$align"! if $align && $align ne '-';
+  my $xhtml = $cfg->entry("basic", "xhtml", 1);
+  unless ($xhtml) {
+    unless (defined($rest) && $rest =~ /\bborder=/i) {
+      $html .= ' border="0"' ;
+    }
+  }
+  defined $rest or $rest = '';
+  # remove any non-img options
+  $rest =~ s/\w+:\w+=(?:(["'])[^"']*\1|\S+)//g;
+  $rest =~ /\bclass=/ or $rest .= ' class="bse_image_tag"';
+
+  $html .= " $rest" if $rest;
+  $html .= qq! />!;
+  if ($im->{url}) {
+    $html = qq!<a href="$im->{url}">$html</a>!;
+  }
+
+  return $html;
+}
+
+sub inline {
+  my ($self, %opts) = @_;
+
+  my $image = delete $opts{image}
+    or confess "Missing image parameter";
+  my $align = delete $opts{align}
+    or confess "Missing align parameter";
+
+  my $xhtml = $self->cfg->entry("basic", "xhtml", 1);
+
+  my $image_url = $image->image_url($self->{cfg});
+  my $html;
+  if ($xhtml) {
+    $html = qq!<img src="$image_url"!
+      .qq! width="$image->{width}" height="$image->{height}"!
+       .qq! alt="$image->{alt}" class="bse_image_$align" />!;
+  }
+  else {
+    $html = qq!<img src="$image_url"!
+      .qq! width="$image->{width}" height="$image->{height}" border="0"!
+       .qq! alt="$image->{alt}" align="$align" hspace="10" vspace="10" />!;
+  }
+  if ($image->{url}) {
+    $html = qq!<a href="$image->{url}">$html</a>!;
+  }
+  
+  return $html;
+}
+
+sub _make_thumb_hash {
+  my ($self, $geo_id, $im, $static) = @_;
+
+  my $cfg = $self->cfg;
+  my $debug = $cfg->entry('debug', 'thumbnails', 0);
+
+  $static ||= 0;
+
+  $debug
+    and print STDERR "_make_thumb_hash(..., $geo_id, $im->{src}, ..., $static)\n";
+
+  $geo_id =~ /^[\w,]+$/
+    or return ( undef, "* invalid geometry id *" );
+
+  my $geometry = $cfg->entry('thumb geometries', $geo_id)
+    or return ( undef, "* cannot find thumb geometry $geo_id *" );
+
+  my $thumbs_class = $cfg->entry('editor', 'thumbs_class')
+    or return ( undef, '* no thumbnail engine configured *' );
+
+  (my $thumbs_file = $thumbs_class . ".pm") =~ s!::!/!g;
+  require $thumbs_file;
+  my $thumbs = $thumbs_class->new($cfg);
+
+  $debug
+    and print STDERR "  Thumb class $thumbs_class\n";
+
+  my $error;
+  $thumbs->validate_geometry($geometry, \$error)
+    or return ( undef, "* invalid geometry string: $error *" );
+
+  my %im = map { $_ => $im->{$_} } $im->columns;
+  my $base = $self->thumb_base_url;
+
+  @im{qw/width height type original/} = 
+    $thumbs->thumb_dimensions_sized($geometry, @$im{qw/width height/});
+
+  my $do_cache = $cfg->entry('basic', 'cache_thumbnails', 1);
+  $im{image} = '';
+  if ($im{original}) {
+    $debug
+      and print STDERR "  Using original\n";
+    $im{image} = $im->{src};
+  }
+  elsif ($static && $do_cache) {
+    require BSE::Util::Thumb;
+    ($im{image}) = BSE::Util::Thumb->generate_thumb($cfg, $im, $geo_id, $thumbs);
+    $debug
+      and print STDERR "  Generated $im{image}\n";
+  }
+  unless ($im{image}) {
+    $im{image} = "$base?g=$geo_id&page=$im->{articleId}&image=$im->{id}";
+
+    if (defined $im{type}) {
+      $im{image} .= "&type.$im{type}";
+    }
+    else {
+      $im{image} .= "&" . $im->{image};
+    }
+
+
+    $debug
+      and print STDERR "  Defaulting to dynamic thumb url $im{image}\n";
+  }
+  $im{src} = $im{image};
+
+  return \%im;
+}
+
+sub thumb {
+  my ($self, %opts) = @_;
+
+  my $geo_id = delete $opts{geo};
+  defined $geo_id 
+    or confess "Missing geo parameter";
+  my $im = delete $opts{image}
+    or confess "Missing image parameter";
+  my $field = delete $opts{field} || '';
+  my $static = delete $opts{static} || 0;
+  my $cfg = $self->cfg;
+
+  my ($imwork, $error) = 
+    $self->_make_thumb_hash($geo_id, $im, $static);
+
+  $imwork
+    or return escape_html($error);
+  
+  if ($field) {
+    my $value = $imwork->{$field};
+    defined $value or $value = '';
+    return escape_html($value);
+  }
+  else {
+    my $class = $cfg->entry('thumb classes', $geo_id, "bse_image_thumb");
+    my $xhtml = $cfg->entry("basic", "xhtml", 1);
+    my $html = '<img src="' . escape_html($imwork->{src}) . '" alt="' . escape_html($imwork->{alt}) . qq!" width="$imwork->{width}" height="$imwork->{height}"!;
+    $html .= qq! border="0"! unless $xhtml;
+    if ($class) {
+      $html .= qq! class="$class"!;
+    }
+    $html .= ' />';
+    if ($imwork->{url}) {
+      $html = '<a href="' . escape_html($imwork->{url}) . '">' . $html . "</a>";
+    }
+    return $html;
+  }
+}
+
+1;
index 807977e..f2d89e4 100644 (file)
@@ -21,8 +21,8 @@ sub type {
 }
 
 sub files {
-  require Images;
-  return Images->image_storages;
+  require BSE::TB::Images;
+  return BSE::TB::Images->image_storages;
 }
 
 sub metadata {
diff --git a/site/cgi-bin/modules/BSE/TB/Image.pm b/site/cgi-bin/modules/BSE/TB/Image.pm
new file mode 100644 (file)
index 0000000..eca1f8c
--- /dev/null
@@ -0,0 +1,75 @@
+package BSE::TB::Image;
+use strict;
+# represents an image from the database
+use Squirrel::Row;
+use vars qw/@ISA/;
+@ISA = qw/Squirrel::Row/;
+use Carp qw(confess);
+use DevHelp::HTML qw(escape_html);
+
+sub columns {
+  return qw/id articleId image alt width height url displayOrder name
+            storage src ftype/;
+}
+
+sub _handler_object {
+  my ($im, $cfg) = @_;
+
+  my $module = "BSE::ImageHandler::" . ucfirst($im->ftype);
+  (my $file = $module . ".pm") =~ s(::)(/)g;
+  require $file;
+  my $handler = $module->new(cfg => $cfg);
+}
+
+sub formatted {
+  my ($self, %opts) = @_;
+
+  my $cfg = delete $opts{cfg}
+    or confess "Missing cfg parameter";
+
+  my $handler = $self->_handler_object($cfg);
+
+  return $handler->format
+    (
+     image => $self,
+     %opts,
+    );
+}
+
+sub inline {
+  my ($self, %opts) = @_;
+
+  my $cfg = delete $opts{cfg}
+    or confess "Missing cfg parameter";
+
+  my $handler = $self->_handler_object($cfg);
+
+  return $handler->inline
+    (
+     image => $self,
+     %opts,
+    );
+}
+
+sub thumb {
+  my ($im, %opts) = @_;
+
+  my $cfg = delete $opts{cfg}
+    or confess "Missing cfg parameter";
+
+  my $handler = $im->_handler_object($cfg);
+
+  return $handler->thumb
+    (
+     image => $im,
+     %opts,
+    );
+}
+
+sub image_url {
+  my ($im, $cfg) = @_;
+
+  $im->src || "/images/$im->{image}";
+}
+
+1;
diff --git a/site/cgi-bin/modules/BSE/TB/Images.pm b/site/cgi-bin/modules/BSE/TB/Images.pm
new file mode 100644 (file)
index 0000000..881785d
--- /dev/null
@@ -0,0 +1,16 @@
+package BSE::TB::Images;
+use strict;
+use Squirrel::Table;
+use vars qw(@ISA $VERSION);
+@ISA = qw(Squirrel::Table);
+use BSE::TB::Image;
+
+sub rowClass {
+  return 'BSE::TB::Image';
+}
+
+sub image_storages {
+  return map [ $_->{image}, $_->{storage}, $_ ], BSE::TB::Images->all;
+}
+
+1;
index eaae37b..314db0d 100644 (file)
@@ -2,44 +2,24 @@ package BSE::TagFormats;
 use strict;
 use DevHelp::HTML;
 
-sub image_url {
-  my ($self, $im) = @_;
-
-  $im->{src} || "/images/$im->{image}";
-}
-
 sub _format_image {
   my ($self, $im, $align, $rest) = @_;
 
   if ($align && exists $im->{$align}) {
     if ($align eq 'src') {
-      return escape_html($self->image_url($im));
+      return escape_html($im->image_url($self->{cfg}));
     }
     else {
       return escape_html($im->{$align});
     }
   }
   else {
-    my $image_url = $self->image_url($im);
-    my $html = qq!<img src="$image_url" width="$im->{width}"!
-      . qq! height="$im->{height}" alt="! . escape_html($im->{alt})
-            . qq!"!;
-    $html .= qq! align="$align"! if $align && $align ne '-';
-    my $xhtml = $self->{cfg}->entry("basic", "xhtml", 1);
-    unless ($xhtml) {
-      unless (defined($rest) && $rest =~ /\bborder=/i) {
-       $html .= ' border="0"' ;
-      }
-    }
-    defined $rest or $rest = '';
-    $rest =~ /\bclass=/ or $rest .= ' class="bse_image_tag"';
-
-    $html .= " $rest" if $rest;
-    $html .= qq! />!;
-    if ($im->{url}) {
-      $html = qq!<a href="$im->{url}">$html</a>!;
-    }
-    return $html;
+    return $im->formatted
+      (
+       cfg => $self->{cfg},
+       align => $align,
+       extras => $rest,
+      );
   }
 }
 
index c8b9a55..6386d5b 100644 (file)
@@ -2,106 +2,16 @@ package BSE::ThumbLow;
 use strict;
 use DevHelp::HTML;
 
-sub thumb_base_url {
-  '/cgi-bin/thumb.pl';
-}
-
-sub _make_thumb_hash {
-  my ($self, $geo_id, $im, $cfg, $static) = @_;
-
-  my $debug = $cfg->entry('debug', 'thumbnails', 0);
-
-  $static ||= 0;
-
-  $debug
-    and print STDERR "_make_thumb_hash(..., $geo_id, $im->{src}, ..., $static)\n";
-
-  $geo_id =~ /^[\w,]+$/
-    or return ( undef, "* invalid geometry id *" );
-
-  my $geometry = $cfg->entry('thumb geometries', $geo_id)
-    or return ( undef, "* cannot find thumb geometry $geo_id *" );
-
-  my $thumbs_class = $cfg->entry('editor', 'thumbs_class')
-    or return ( undef, '* no thumbnail engine configured *' );
-
-  (my $thumbs_file = $thumbs_class . ".pm") =~ s!::!/!g;
-  require $thumbs_file;
-  my $thumbs = $thumbs_class->new($cfg);
-
-  $debug
-    and print STDERR "  Thumb class $thumbs_class\n";
-
-  my $error;
-  $thumbs->validate_geometry($geometry, \$error)
-    or return ( undef, "* invalid geometry string: $error *" );
-
-  my %im = map { $_ => $im->{$_} } $im->columns;
-  my $base = $self->thumb_base_url;
-
-  @im{qw/width height type original/} = 
-    $thumbs->thumb_dimensions_sized($geometry, @$im{qw/width height/});
-
-  my $do_cache = $cfg->entry('basic', 'cache_thumbnails', 1);
-  $im{image} = '';
-  if ($im{original}) {
-    $debug
-      and print STDERR "  Using original\n";
-    $im{image} = $im->{src};
-  }
-  elsif ($static && $do_cache) {
-    require BSE::Util::Thumb;
-    ($im{image}) = BSE::Util::Thumb->generate_thumb($cfg, $im, $geo_id, $thumbs);
-    $debug
-      and print STDERR "  Generated $im{image}\n";
-  }
-  unless ($im{image}) {
-    $im{image} = "$base?g=$geo_id&page=$im->{articleId}&image=$im->{id}";
-
-    if (defined $im{type}) {
-      $im{image} .= "&type.$im{type}";
-    }
-    else {
-      $im{image} .= "&" . $im->{image};
-    }
-
-
-    $debug
-      and print STDERR "  Defaulting to dynamic thumb url $im{image}\n";
-  }
-  $im{src} = $im{image};
-
-  return \%im;
-}
-
 sub _thumbimage_low {
   my ($self, $geo_id, $im, $field, $cfg, $static) = @_;
 
-  my ($imwork, $error) = 
-    $self->_make_thumb_hash($geo_id, $im, $cfg, $static);
-
-  $imwork
-    or return escape_html($error);
-  
-  if ($field) {
-    my $value = $imwork->{$field};
-    defined $value or $value = '';
-    return escape_html($value);
-  }
-  else {
-    my $class = $cfg->entry('thumb classes', $geo_id, "bse_image_thumb");
-    my $xhtml = $cfg->entry("basic", "xhtml", 1);
-    my $html = '<img src="' . escape_html($imwork->{src}) . '" alt="' . escape_html($imwork->{alt}) . qq!" width="$imwork->{width}" height="$imwork->{height}"!;
-    $html .= qq! border="0"! unless $xhtml;
-    if ($class) {
-      $html .= qq! class="$class"!;
-    }
-    $html .= ' />';
-    if ($imwork->{url}) {
-      $html = '<a href="' . escape_html($imwork->{url}) . '">' . $html . "</a>";
-    }
-    return $html;
-  }
+  return $im->thumb
+    (
+     geo => $geo_id,
+     field => $field,
+     cfg => $cfg,
+     static => $static,
+    );
 }
 
 1;
index e1c5563..e47923b 100644 (file)
@@ -9,7 +9,7 @@ use BSE::Template;
 #use Squirrel::ImageEditor;
 use Constants qw(:shop $SHOPID $PRODUCTPARENT 
                  $SHOP_URI $CGI_URI $IMAGES_URI $AUTO_GENERATE);
-use Images;
+use BSE::TB::Images;
 use Articles;
 use BSE::Sort;
 use BSE::Util::Tags qw(tag_hash);
index dd0ff27..9db2256 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::UI::Image;
 use strict;
 use Articles;
-use Images;
+use BSE::TB::Images;
 use BSE::Util::Tags qw(tag_hash);
 use DevHelp::HTML qw(escape_uri);
 
@@ -22,7 +22,7 @@ sub dispatch {
   if (defined(my $imid = $cgi->param('imid'))) {
     $imid =~ /^\d+$/
       or return $class->error($req, "Invalid imid supplied");
-    $image = Images->getByPkey($imid);
+    $image = BSE::TB::Images->getByPkey($imid);
 
     $image && $image->{articleId} == $article->{id}
       or return $class->error($req, "Unknown image identifier supplied");
@@ -30,7 +30,7 @@ sub dispatch {
   elsif (defined(my $imname = $cgi->param('imname'))) {
     length $imname and $imname =~ /^\w+$/
       or return $class->error($req, "Invalid imname supplied");
-    ($image) = Images->getBy(articleId=>$article->{id}, name=>$imname)
+    ($image) = BSE::TB::Images->getBy(articleId=>$article->{id}, name=>$imname)
       or return $class->error($req, "Unknown image name supplied");
   }
 
index 06ab995..3ddece4 100644 (file)
@@ -1,7 +1,7 @@
 package BSE::UI::Thumb;
 use strict;
 use base 'BSE::UI::Dispatch'; # for error
-use Images;
+use BSE::TB::Images;
 use BSE::CfgInfo qw(cfg_image_dir);
 use BSE::Util::Thumb;
 
@@ -26,7 +26,7 @@ sub dispatch {
   $thumbs->validate_geometry($geometry, \$error)
     or return $class->error($req, "invalid geometry string: $error");
   
-  my $image = Images->getByPkey($image_id);
+  my $image = BSE::TB::Images->getByPkey($image_id);
   $image && $image->{articleId} == $article_id
     or return $class->error($req, "image not found");
 
index de8d7d7..77ec4a4 100644 (file)
@@ -1,6 +1,6 @@
 package BSE::Util::Thumb;
 use strict;
-use Images;
+use BSE::TB::Images;
 use BSE::CfgInfo qw(cfg_image_dir);
 use BSE::StorageMgr::Thumbs;
 
index 1fc637d..b35442f 100644 (file)
@@ -261,22 +261,7 @@ sub format_body {
       # adjust to make sure this isn't in the middle of a tag or entity
       my $pos = $self->adjust_for_html($body, $incr);
       
-      # assuming 5.005_03 would make this simpler, but <sigh>
-      my $image_url = $self->image_url($image);
-      my $img;
-      if ($xhtml) {
-       $img = qq!<img src="$image_url"!
-         .qq! width="$image->{width}" height="$image->{height}"!
-           .qq! alt="$image->{alt}" class="bse_image_$align" />!;
-      }
-      else {
-       $img = qq!<img src="$image_url"!
-         .qq! width="$image->{width}" height="$image->{height}" border="0"!
-           .qq! alt="$image->{alt}" align="$align" hspace="10" vspace="10" />!;
-      }
-      if ($image->{url}) {
-       $img = qq!<a href="$image->{url}">$img</a>!;
-      }
+      my $img = $image->inline(cfg => $self->{cfg}, align => $align);
       $output .= $img;
       $output .= substr($body, 0, $pos);
       substr($body, 0, $pos) = '';
@@ -403,8 +388,8 @@ sub iter_gimages {
   my ($self, $args) = @_;
 
   unless ($self->{gimages}) {
-    require Images;
-    my @gimages = Images->getBy(articleId => -1);
+    require BSE::TB::Images;
+    my @gimages = BSE::TB::Images->getBy(articleId => -1);
     my %gimages = map { $_->{name} => $_ } @gimages;
     $self->{gimages} = \%gimages;
   }
@@ -1146,8 +1131,8 @@ sub get_gimage {
   my ($self, $name) = @_;
 
   unless ($self->{gimages}) {
-    require Images;
-    my @gimages = Images->getBy(articleId => -1);
+    require BSE::TB::Images;
+    my @gimages = BSE::TB::Images->getBy(articleId => -1);
     my %gimages = map { $_->{name} => $_ } @gimages;
     $self->{gimages} = \%gimages;
   }
index a913c74..f6b5b4a 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use BSE::Template;
 use Constants qw(%LEVEL_DEFAULTS $CGI_URI $ADMIN_URI $IMAGES_URI 
                  $UNLISTED_LEVEL1_IN_CRUMBS);
-use Images;
+use BSE::TB::Images;
 use vars qw(@ISA);
 use Generate;
 use Util qw(generate_button);
@@ -89,8 +89,8 @@ sub tag_title {
   }
   else {
     my $id = $templater->perform($acts, $which, 'id');
-    require Images;
-    my @images = Images->getBy(articleId=>$id);
+    require BSE::TB::Images;
+    my @images = BSE::TB::Images->getBy(articleId=>$id);
     ($im) = grep lc $_->{name} eq 'bse_title', @$images;
   }
 
@@ -334,7 +334,7 @@ sub baseActs {
   my $parent = $articles->getByPkey($article->{parentid});
   my $section = @crumbs ? $crumbs[0] : $article;
 
-  my @images = Images->getBy('articleId', $article->{id});
+  my @images = BSE::TB::Images->getBy('articleId', $article->{id});
   my @unnamed_images = grep $_->{name} eq '', @images;
   my @iter_images;
   my $image_index = -1;
index 70349a5..21f76f1 100644 (file)
@@ -2,7 +2,7 @@ package Generate::Product;
 use strict;
 use Generate::Article;
 use Products;
-use Images;
+use BSE::TB::Images;
 use base qw(Generate::Article);
 use Constants qw(:shop $CGI_URI $ADMIN_URI);
 use Carp qw(confess);
diff --git a/site/cgi-bin/modules/Image.pm b/site/cgi-bin/modules/Image.pm
deleted file mode 100644 (file)
index e855042..0000000
+++ /dev/null
@@ -1,13 +0,0 @@
-package Image;
-use strict;
-# represents an image from the database
-use Squirrel::Row;
-use vars qw/@ISA/;
-@ISA = qw/Squirrel::Row/;
-
-sub columns {
-  return qw/id articleId image alt width height url displayOrder name
-            storage src/;
-}
-
-1;
diff --git a/site/cgi-bin/modules/Images.pm b/site/cgi-bin/modules/Images.pm
deleted file mode 100644 (file)
index 19b0b3a..0000000
+++ /dev/null
@@ -1,16 +0,0 @@
-package Images;
-use strict;
-use Squirrel::Table;
-use vars qw(@ISA $VERSION);
-@ISA = qw(Squirrel::Table);
-use Image;
-
-sub rowClass {
-  return 'Image';
-}
-
-sub image_storages {
-  return map [ $_->{image}, $_->{storage}, $_ ], Images->all;
-}
-
-1;
index 686628c..eaa1f1d 100644 (file)
@@ -214,3 +214,7 @@ table#backtasklist tr.running td {
 table#backtasklist tr.failed td { 
   background-color: #FFE0E0;
 }
+
+img.bse_image_thumb { 
+  border: none;
+}
\ No newline at end of file
index d6b70a2..2f202fa 100644 (file)
@@ -64,3 +64,16 @@ form td.submit { text-align: right; }
   margin: 5px 0px;
   vertical-align: middle;
 }
+
+.body .bse_flash_right { 
+  border: 0px;
+  margin: 5px;
+  float: right;
+}
+
+.body .bse_flash_left { 
+  border: 0px;
+  margin: 5px;
+  float: left;
+}
+
index 3c8d8b5..45e4ebc 100644 (file)
           </tr>
           <: iterator begin images :> 
           <tr bgcolor="#FFFFFF"> 
-            <td align="center" colspan="5"> <img src="<: image src :>" alt="<: image alt :>" width="<: 
-              image width :>" height="<: image height :>" /></td>
+            <td align="center" colspan="5"><:image:></td>
           </tr>
           <tr bgcolor="#FFFFFF"> 
             <th> Alt Text</th>
index d5a2bd5..ab5f4cf 100644 (file)
@@ -3,7 +3,7 @@
 <p><b><:message:></b></p>
 <:or:><:eif:> 
 <:include admin/product_menu.tmpl:>
-  <h2>Product Details</h2>
+  <h2><:ifNew:>Add Product<:or:>Product Details<:eif:></h2>
 <:ifNew:><:or:><:if Or [iadminuser_count] [iadmingroup_count]:>
       <form action="/cgi-bin/admin/adminusers.pl">
   <input type="hidden" name="id" value="<: article id:>" />
index f434996..c42fd9b 100644 (file)
@@ -2,11 +2,11 @@
 |
 <a href="/cgi-bin/admin/menu.pl">Admin Menu</a>
 |
-<:ifEq [param menuitem] edit:>
-<span>Edit product</span>
-<:or:>
+<:if Eq [param menuitem] edit:>
+<span><:ifNew:>Add<:or:>Edit<:eif:> product</span>
+<:or Eq:>
 <a href="<:script:>?id=<:article id:>">Edit product</a>
-<:eif:>
+<:eif Eq:>
 |
 <:if New:><:or New:>
 <:if Eq [param menuitem] "edit":>
index 3f36bc2..6053665 100644 (file)
@@ -306,6 +306,7 @@ Column displayOrder;int(11);NO;0;
 Column name;varchar(255);NO;;
 Column storage;varchar(20);NO;local;
 Column src;varchar(255);NO;;
+Column ftype;varchar(20);NO;img;
 Index PRIMARY;1;[id]
 Table order_item
 Column id;int(11);NO;NULL;auto_increment
index 7ba1c34..182220d 100644 (file)
@@ -71,4 +71,4 @@ fetch_ok($ua, "reorder", "$baseurl/cgi-bin/admin/reorder.pl",
 fetch_ok($ua, 'fmail', "$baseurl/cgi-bin/fmail.pl",
         qr!name="form"!);
 fetch_ok($ua, 'page.pl?page=1', "$baseurl/cgi-bin/page.pl?page=1",
-        qr!welcome\s+to\stest\s+server!i);
+        qr!welcome\s+to\s!i);
index c837c6b..59f4319 100644 (file)
@@ -36,6 +36,8 @@ for my $name ('One', 'Two', 'Three') {
   push(@kids, $kid);
 }
 
+my $base_securl = $cfg->entryVar("site", "secureurl");
+
 # make parent a step child of itself
 require BSE::Admin::StepParents;
 BSE::Admin::StepParents->add($parent, $parent);
@@ -288,7 +290,7 @@ EXPECTED
 template_test "body", $parent, <<'TEMPLATE', <<EXPECTED;
 <:body:>
 TEMPLATE
-<p>parent article <a href="http://bsetestshop.develop-help.com/shop/index.html" title="The Shop" class="doclink">foo</a></p>
+<p>parent article <a href="$base_securl/shop/index.html" title="The Shop" class="doclink">foo</a></p>
 EXPECTED
 
 # not actually generation tests, but chekcs that the is_step_ancestor works