site/cgi-bin/modules/BSE/TB/SiteCommon.pm

   1 package BSE::TB::SiteCommon;
   2 use strict;
   3 use Carp qw(confess);
   4
   5 our $VERSION = "1.005";
   6
   7 =head1 NAME
   8
   9 BSE::TB::SiteCommon - methods common to the site and article objects
  10
  11 =head1 SYNOPSIS
  12
  13   my @steps = $article->set_parents;
  14   my @sections = $site->children;
  15
  16 =head1 DESCRIPTION
  17
  18 Provides methods common to the Article and BSE::TB::Site objects.
  19
  20 =head1 USEFUL METHODS
  21
  22 =over
  23
  24 =cut
  25
  26 sub step_parents {
  27   my ($self) = @_;
  28
  29   Articles->getSpecial('stepParents', $self->{id});
  30 }
  31
  32 sub visible_step_parents {
  33   my ($self) = @_;
  34
  35   my $now = now_sqldate();
  36   Articles->getSpecial('visibleStepParents', $self->{id}, $now);
  37 }
  38
  39 sub stepkids {
  40   my ($self) = @_;
  41
  42   return Articles->getSpecial('stepKids', $self->{id});
  43 }
  44
  45 sub allstepkids {
  46   my ($self) = @_;
  47
  48   return Articles->getSpecial('stepKids', $self->{id});
  49 }
  50
  51 sub visible_stepkids {
  52   my ($self) = @_;
  53
  54   use BSE::Util::SQL qw/now_sqldate/;
  55   my $today = now_sqldate();
  56
  57   if ($self->{generator} eq 'Generate::Catalog') {
  58     require 'Products.pm';
  59
  60     return Products->getSpecial('visibleStep', $self->{id}, $today);
  61   }
  62   else {
  63     return Articles->getSpecial('visibleStepKids', $self->{id}, $today);
  64   }
  65
  66   return ();
  67 }
  68
  69 # returns a list of all children in the correct sort order
  70 # this is a bit messy
  71 sub allkids {
  72   my ($self) = @_;
  73
  74   require 'OtherParents.pm';
  75
  76   my @otherlinks = OtherParents->getBy(parentId=>$self->{id});
  77   my @normalkids = Articles->children($self->{id});
  78   my %order = (
  79                (map { $_->{id}, $_->{displayOrder} } @normalkids ),
  80                (map { $_->{childId}, $_->{parentDisplayOrder} } @otherlinks),
  81               );
  82   my @stepkids = $self->allstepkids;
  83   my %kids = map { $_->{id}, $_ } @stepkids, @normalkids;
  84
  85   return @kids{ sort { $order{$b} <=> $order{$a} } keys %kids };
  86 }
  87
  88 # returns a list of all visible children in the correct sort order
  89 # this is a bit messy
  90 sub all_visible_kids {
  91   my ($self) = @_;
  92
  93   Articles->all_visible_kids($self->{id});
  94 }
  95
  96 sub all_visible_kid_tags {
  97   my ($self) = @_;
  98
  99   Articles->all_visible_kid_tags($self->{id});
 100 }
 101
 102 sub all_visible_products {
 103   my ($self) = @_;
 104
 105   require Products;
 106   Products->all_visible_children($self->{id});
 107 }
 108
 109 sub all_visible_product_tags {
 110   my ($self) = @_;
 111
 112   require Products;
 113   Products->all_visible_product_tags($self->{id});
 114 }
 115
 116 sub all_visible_catalogs {
 117   my ($self) = @_;
 118
 119   return grep $_->{generator} eq "Generate::Catalog", $self->all_visible_kids;
 120 }
 121
 122 sub visible_kids {
 123   my ($self) = @_;
 124
 125   return Articles->listedChildren($self->{id});
 126 }
 127
 128 =item menu_kids
 129
 130 Returns a list of children meant to be listed in menus.
 131
 132 =cut
 133
 134 sub menu_kids {
 135   my ($self) = @_;
 136
 137   return grep $_->listed_in_menu, $self->visible_kids;
 138 }
 139
 140
 141 =item menu_kids
 142
 143 Returns a list of allkids meant to be listed in menus.
 144
 145 =cut
 146
 147 sub all_menu_kids {
 148   my ($self) = @_;
 149
 150   return grep $_->listed_in_menu, $self->all_visible_kids;
 151 }
 152
 153 sub images {
 154   my ($self) = @_;
 155   require BSE::TB::Images;
 156   BSE::TB::Images->getBy(articleId=>$self->{id});
 157 }
 158
 159 sub children {
 160   my ($self) = @_;
 161
 162   return sort { $b->{displayOrder} <=> $a->{displayOrder} }
 163     Articles->children($self->{id});
 164 }
 165
 166 sub files {
 167   my ($self) = @_;
 168
 169   require BSE::TB::ArticleFiles;
 170   return BSE::TB::ArticleFiles->getBy(articleId=>$self->{id});
 171 }
 172
 173 sub remove_images {
 174   my ($self, $cfg) = @_;
 175
 176   my @images = $self->images;
 177   my $mgr;
 178   my $imagedir = $cfg->entry('paths', 'images', $Constants::IMAGEDIR);
 179   for my $image (@images) {
 180     if ($image->{storage} ne 'local') {
 181       unless ($mgr) {
 182         require BSE::StorageMgr::Images;
 183         $mgr = BSE::StorageMgr::Images->new(cfg => $cfg);
 184       }
 185       $mgr->unstore($image->{image}, $image->{storage});
 186     }
 187
 188     unlink("$imagedir/$image->{image}");
 189     $image->remove();
 190   }
 191 }
 192
 193 sub _copy_fh_to_fh {
 194   my ($in, $out) = @_;
 195
 196   local $/ = \8192;
 197   while (my $data = <$in>) {
 198     print $out $data
 199       or return;
 200   }
 201
 202   return 1;
 203 }
 204
 205 sub add_file {
 206   my ($self, $cfg, %opts) = @_;
 207
 208   require BSE::TB::ArticleFiles;
 209   defined $opts{displayName} && $opts{displayName} =~ /\S/
 210     or die "displayName must be non-blank\n";
 211
 212   unless ($opts{contentType}) {
 213     require BSE::Util::ContentType;
 214     $opts{contentType} = BSE::Util::ContentType::content_type($cfg, $opts{displayName});
 215   }
 216
 217   my $src_filename = delete $opts{filename};
 218   my $file_dir = BSE::TB::ArticleFiles->download_path($cfg);
 219   my $filename;
 220   if ($src_filename) {
 221     if ($src_filename =~ /^\Q$file_dir\E/) {
 222       # created in the right place, use it
 223       $filename = $src_filename;
 224     }
 225     else {
 226       open my $in_fh, "<", $src_filename
 227         or die "Cannot open $src_filename: $!\n";
 228       binmode $in_fh;
 229
 230       require DevHelp::FileUpload;
 231       my $msg;
 232       ($filename, my $out_fh) = DevHelp::FileUpload->
 233         make_img_filename($file_dir, $opts{displayName}, \$msg)
 234           or die "$msg\n";
 235       _copy_fh_to_fh($in_fh, $out_fh)
 236         or die "Cannot copy file data to $filename: $!\n";
 237       close $out_fh
 238         or die "Cannot close output data: $!\n";
 239     }
 240   }
 241   elsif ($opts{file}) {
 242     my $file = delete $opts{file};
 243     my $out_fh;
 244     require DevHelp::FileUpload;
 245     my $msg;
 246     ($filename, $out_fh) = DevHelp::FileUpload->
 247         make_img_filename($file_dir, $opts{displayName}, \$msg)
 248           or die "$msg\n";
 249     require File::Copy;
 250     _copy_fh_to_fh($file, $out_fh)
 251         or die "Cannot copy file data to $filename: $!\n";
 252     close $out_fh
 253       or die "Cannot close output data: $!\n";
 254   }
 255   else {
 256     die "No source file provided\n";
 257   }
 258
 259   my $name = $opts{name};
 260   $self->id != -1 || defined $name && $name =~ /\S/
 261     or die "name is required for global files\n";
 262   if (defined $name && $name =~ /\S/) {
 263     $name =~ /^\w+$/
 264       or die "name must be a single word\n";
 265     my ($other) = BSE::TB::ArticleFiles->getBy(articleId => $self->id,
 266                                                name => $name)
 267       and die "Duplicate file name (identifier)\n";
 268   }
 269
 270   require BSE::Util::SQL;
 271   my $fullpath = $file_dir . '/' . $filename;
 272   $opts{filename} = $filename;
 273   $opts{sizeInBytes} = -s $fullpath;
 274   $opts{displayOrder} = time;
 275   $opts{articleId} = $self->id;
 276
 277   my $store = delete $opts{store};
 278   my $storage = delete $opts{storage} || '';
 279
 280   my $fileobj = BSE::TB::ArticleFiles->make(%opts);
 281   $fileobj->set_handler($cfg);
 282   $fileobj->save;
 283
 284   if ($store) {
 285     my $msg;
 286     eval {
 287       $self->apply_storage($cfg, $fileobj, $storage, \$msg);
 288     };
 289     $@ and $msg = $@;
 290     if ($msg) {
 291       if ($opts{msg}) {
 292         ${$opts{msg}} = $msg;
 293       }
 294       else {
 295         $fileobj->remove($cfg);
 296         die $msg;
 297       }
 298     }
 299   }
 300
 301   return $fileobj;
 302 }
 303
 304 # only some files can be stored remotely
 305 sub select_filestore {
 306   my ($self, $mgr, $file, $storage, $rmsg) = @_;
 307
 308   my $store = $mgr->select_store($file->{filename}, $storage, $file);
 309   if ($store ne 'local') {
 310     if ($file->{forSale} || $file->{requireUser}) {
 311       $store = 'local';
 312       $$rmsg = "For sale or user required files can only be stored locally";
 313     }
 314     elsif ($file->{articleId} != -1 && $file->article->is_access_controlled) {
 315       $store = 'local';
 316       $$rmsg = "Files for access controlled articles can only be stored locally";
 317     }
 318   }
 319
 320   return $store;
 321 }
 322
 323 sub apply_storage {
 324   my ($self, $cfg, $file, $storage, $rmsg) = @_;
 325
 326   $file
 327     or confess "Missing file option";
 328   $storage ||= '';
 329   my $mgr = BSE::TB::ArticleFiles->file_manager($cfg);
 330   $storage = $self->select_filestore($mgr, $file, $storage, $rmsg);
 331   $file->apply_storage($cfg, $mgr, $storage);
 332 }
 333
 334 =item reorder_child($child_id, $after_id)
 335
 336 Change the order of children of $self so that $child_id is after
 337 $after_id.
 338
 339 If $after_id is zero then $child_id becomes the first child.
 340
 341 =cut
 342
 343 sub reorder_child {
 344   my ($self, $child_id, $after_id) = @_;
 345
 346   Articles->reorder_child($self->{id}, $child_id, $after_id);
 347 }
 348
 349 sub set_image_order {
 350   my ($self, $order) = @_;
 351
 352   my @images = $self->images;
 353   my %images = map { $_->{id} => $_ } @images;
 354
 355   my @new_order;
 356   for my $id (@$order) {
 357     if ($images{$id}) {
 358       push @new_order, delete $images{$id};
 359     }
 360   }
 361   for my $id (map $_->id, @images) {
 362     if ($images{$id}) {
 363       push @new_order, delete $images{$id};
 364     }
 365   }
 366
 367   my @display_order = map $_->{displayOrder}, @images;
 368   for my $index (0 .. $#images) {
 369     $new_order[$index]->set_displayOrder($display_order[$index]);
 370     $new_order[$index]->save;
 371   }
 372
 373   return @new_order;
 374 }
 375
 376 1;
 377
 378 __END__
 379
 380 =back
 381
 382 =head1 AUTHOR
 383
 384 Tony Cook <tony@develop-help.com>
 385
 386 =cut