[bse.git] / site / cgi-bin / modules / BSE / TB / SiteCommon.pm

package BSE::TB::SiteCommon;
use strict;
use Carp qw(confess);

our $VERSION = "1.005";

=head1 NAME

BSE::TB::SiteCommon - methods common to the site and article objects

=head1 SYNOPSIS

  my @steps = $article->set_parents;
  my @sections = $site->children;

=head1 DESCRIPTION

Provides methods common to the Article and BSE::TB::Site objects.

=head1 USEFUL METHODS

=over

=cut

sub step_parents {
  my ($self) = @_;

  Articles->getSpecial('stepParents', $self->{id});
}

sub visible_step_parents {
  my ($self) = @_;

  my $now = now_sqldate();
  Articles->getSpecial('visibleStepParents', $self->{id}, $now);
}

sub stepkids {
  my ($self) = @_;

  return Articles->getSpecial('stepKids', $self->{id});
}

sub allstepkids {
  my ($self) = @_;

  return Articles->getSpecial('stepKids', $self->{id});
}

sub visible_stepkids {
  my ($self) = @_;

  use BSE::Util::SQL qw/now_sqldate/;
  my $today = now_sqldate();

  if ($self->{generator} eq 'Generate::Catalog') {
    require 'Products.pm';

    return Products->getSpecial('visibleStep', $self->{id}, $today);
  }
  else {
    return Articles->getSpecial('visibleStepKids', $self->{id}, $today);
  }
  
  return ();
}

# returns a list of all children in the correct sort order
# this is a bit messy
sub allkids {
  my ($self) = @_;

  require 'OtherParents.pm';

  my @otherlinks = OtherParents->getBy(parentId=>$self->{id});
  my @normalkids = Articles->children($self->{id});
  my %order = (
	       (map { $_->{id}, $_->{displayOrder} } @normalkids ),
	       (map { $_->{childId}, $_->{parentDisplayOrder} } @otherlinks),
	      );
  my @stepkids = $self->allstepkids;
  my %kids = map { $_->{id}, $_ } @stepkids, @normalkids;

  return @kids{ sort { $order{$b} <=> $order{$a} } keys %kids };
}

# returns a list of all visible children in the correct sort order
# this is a bit messy
sub all_visible_kids {
  my ($self) = @_;

  Articles->all_visible_kids($self->{id});
}

sub all_visible_kid_tags {
  my ($self) = @_;

  Articles->all_visible_kid_tags($self->{id});
}

sub all_visible_products {
  my ($self) = @_;

  require Products;
  Products->all_visible_children($self->{id});
}

sub all_visible_product_tags {
  my ($self) = @_;

  require Products;
  Products->all_visible_product_tags($self->{id});
}

sub all_visible_catalogs {
  my ($self) = @_;

  return grep $_->{generator} eq "Generate::Catalog", $self->all_visible_kids;
}

sub visible_kids {
  my ($self) = @_;

  return Articles->listedChildren($self->{id});
}

=item menu_kids

Returns a list of children meant to be listed in menus.

=cut

sub menu_kids {
  my ($self) = @_;

  return grep $_->listed_in_menu, $self->visible_kids;
}


=item menu_kids

Returns a list of allkids meant to be listed in menus.

=cut

sub all_menu_kids {
  my ($self) = @_;

  return grep $_->listed_in_menu, $self->all_visible_kids;
}

sub images {
  my ($self) = @_;
  require BSE::TB::Images;
  BSE::TB::Images->getBy(articleId=>$self->{id});
}

sub children {
  my ($self) = @_;

  return sort { $b->{displayOrder} <=> $a->{displayOrder} } 
    Articles->children($self->{id});
}

sub files {
  my ($self) = @_;

  require BSE::TB::ArticleFiles;
  return BSE::TB::ArticleFiles->getBy(articleId=>$self->{id});
}

sub remove_images {
  my ($self, $cfg) = @_;

  my @images = $self->images;
  my $mgr;
  my $imagedir = $cfg->entry('paths', 'images', $Constants::IMAGEDIR);
  for my $image (@images) {
    if ($image->{storage} ne 'local') {
      unless ($mgr) {
	require BSE::StorageMgr::Images;
	$mgr = BSE::StorageMgr::Images->new(cfg => $cfg);
      }
      $mgr->unstore($image->{image}, $image->{storage});
    }

    unlink("$imagedir/$image->{image}");
    $image->remove();
  }
}

sub _copy_fh_to_fh {
  my ($in, $out) = @_;

  local $/ = \8192;
  while (my $data = <$in>) {
    print $out $data
      or return;
  }

  return 1;
}

sub add_file {
  my ($self, $cfg, %opts) = @_;

  require BSE::TB::ArticleFiles;
  defined $opts{displayName} && $opts{displayName} =~ /\S/
    or die "displayName must be non-blank\n";
  
  unless ($opts{contentType}) {
    require BSE::Util::ContentType;
    $opts{contentType} = BSE::Util::ContentType::content_type($cfg, $opts{displayName});
  }

  my $src_filename = delete $opts{filename};
  my $file_dir = BSE::TB::ArticleFiles->download_path($cfg);
  my $filename;
  if ($src_filename) {
    if ($src_filename =~ /^\Q$file_dir\E/) {
      # created in the right place, use it
      $filename = $src_filename;
    }
    else {
      open my $in_fh, "<", $src_filename
	or die "Cannot open $src_filename: $!\n";
      binmode $in_fh;

      require DevHelp::FileUpload;
      my $msg;
      ($filename, my $out_fh) = DevHelp::FileUpload->
	make_img_filename($file_dir, $opts{displayName}, \$msg)
	  or die "$msg\n";
      _copy_fh_to_fh($in_fh, $out_fh)
	or die "Cannot copy file data to $filename: $!\n";
      close $out_fh
	or die "Cannot close output data: $!\n";
    }
  }
  elsif ($opts{file}) {
    my $file = delete $opts{file};
    my $out_fh;
    require DevHelp::FileUpload;
    my $msg;
    ($filename, $out_fh) = DevHelp::FileUpload->
	make_img_filename($file_dir, $opts{displayName}, \$msg)
	  or die "$msg\n";
    require File::Copy;
    _copy_fh_to_fh($file, $out_fh)
	or die "Cannot copy file data to $filename: $!\n";
    close $out_fh
      or die "Cannot close output data: $!\n";
  }
  else {
    die "No source file provided\n";
  }

  my $name = $opts{name};
  $self->id != -1 || defined $name && $name =~ /\S/
    or die "name is required for global files\n";
  if (defined $name && $name =~ /\S/) {
    $name =~ /^\w+$/
      or die "name must be a single word\n";
    my ($other) = BSE::TB::ArticleFiles->getBy(articleId => $self->id,
					       name => $name)
      and die "Duplicate file name (identifier)\n";
  }

  require BSE::Util::SQL;
  my $fullpath = $file_dir . '/' . $filename;
  $opts{filename} = $filename;
  $opts{sizeInBytes} = -s $fullpath;
  $opts{displayOrder} = time;
  $opts{articleId} = $self->id;

  my $store = delete $opts{store};
  my $storage = delete $opts{storage} || '';

  my $fileobj = BSE::TB::ArticleFiles->make(%opts);
  $fileobj->set_handler($cfg);
  $fileobj->save;

  if ($store) {
    my $msg;
    eval {
      $self->apply_storage($cfg, $fileobj, $storage, \$msg);
    };
    $@ and $msg = $@;
    if ($msg) {
      if ($opts{msg}) {
	${$opts{msg}} = $msg;
      }
      else {
	$fileobj->remove($cfg);
	die $msg;
      }
    }
  }

  return $fileobj;
}

# only some files can be stored remotely
sub select_filestore {
  my ($self, $mgr, $file, $storage, $rmsg) = @_;

  my $store = $mgr->select_store($file->{filename}, $storage, $file);
  if ($store ne 'local') {
    if ($file->{forSale} || $file->{requireUser}) {
      $store = 'local';
      $$rmsg = "For sale or user required files can only be stored locally";
    }
    elsif ($file->{articleId} != -1 && $file->article->is_access_controlled) {
      $store = 'local';
      $$rmsg = "Files for access controlled articles can only be stored locally";
    }
  }

  return $store;
}

sub apply_storage {
  my ($self, $cfg, $file, $storage, $rmsg) = @_;

  $file
    or confess "Missing file option";
  $storage ||= '';
  my $mgr = BSE::TB::ArticleFiles->file_manager($cfg);
  $storage = $self->select_filestore($mgr, $file, $storage, $rmsg);
  $file->apply_storage($cfg, $mgr, $storage);
}

=item reorder_child($child_id, $after_id)

Change the order of children of $self so that $child_id is after
$after_id.

If $after_id is zero then $child_id becomes the first child.

=cut

sub reorder_child {
  my ($self, $child_id, $after_id) = @_;

  Articles->reorder_child($self->{id}, $child_id, $after_id);
}

sub set_image_order {
  my ($self, $order) = @_;

  my @images = $self->images;
  my %images = map { $_->{id} => $_ } @images;

  my @new_order;
  for my $id (@$order) {
    if ($images{$id}) {
      push @new_order, delete $images{$id};
    }
  }
  for my $id (map $_->id, @images) {
    if ($images{$id}) {
      push @new_order, delete $images{$id};
    }
  }

  my @display_order = map $_->{displayOrder}, @images;
  for my $index (0 .. $#images) {
    $new_order[$index]->set_displayOrder($display_order[$index]);
    $new_order[$index]->save;
  }

  return @new_order;
}

1;

__END__

=back

=head1 AUTHOR

Tony Cook <tony@develop-help.com>

=cut
Commit	Line	Data
7646d96e TC	1	package BSE::TB::SiteCommon;
	2	use strict;
	3	use Carp qw(confess);
	4
599fe373 TC	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
cb7fd78d	25
7646d96e TC	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
44ca1156	42	return Articles->getSpecial('stepKids', $self->{id});
7646d96e TC	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
81aa5f57 TC	96	sub all_visible_kid_tags {
	97	my ($self) = @_;
	98
	99	Articles->all_visible_kid_tags($self->{id});
	100	}
	101
7646d96e TC	102	sub all_visible_products {
	103	my ($self) = @_;
	104
	105	require Products;
	106	Products->all_visible_children($self->{id});
	107	}
	108
81aa5f57 TC	109	sub all_visible_product_tags {
	110	my ($self) = @_;
	111
	112	require Products;
	113	Products->all_visible_product_tags($self->{id});
	114	}
	115
7646d96e TC	116	sub all_visible_catalogs {
	117	my ($self) = @_;
	118
	119	return grep $_->{generator} eq "Generate::Catalog", $self->all_visible_kids;
	120	}
	121
599fe373 TC	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
7646d96e TC	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
599fe373	162	return sort { $b->{displayOrder} <=> $a->{displayOrder} }
7646d96e TC	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};
cd482cec	260	$self->id != -1 \|\| defined $name && $name =~ /\S/
7646d96e TC	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
91fad97a TC	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
9833da10 TC	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
7646d96e	376	1;
599fe373 TC	377
	378	__END__
	379
	380	=back
	381
	382	=head1 AUTHOR
	383
	384	Tony Cook <tony@develop-help.com>
	385
	386	=cut