view release on metacpan or  search on metacpan

lib/Bio/BioStudio/Foswiki.pm  view on Meta::CPAN

}

=head2 wiki_add_feature

=cut

sub wiki_add_feature
{
  my ($pa, $BS, $feat, $buds) = @_;
  my $path = $pa->{CHRPATH} . q{/} . $feat->Tag_load_id . ".txt";
  my @arr = ($pa->{AUTHSTR});
  if ($BS->{enable_gbrowse})
  {
    my $text = "See this feature in GBrowse ($pa->{NEWCHROMOSOME})";
    push @arr, make_link($feat, $text, $pa, $BS) . "<br>";
  }
  foreach my $att ($feat->get_all_tags())
  {
    next if $att eq "load_id";
    push @arr, "$att: " . join(", ", $feat->get_tag_values($att)) . "<br>";
  }
  foreach my $bud (%{$buds})
  {
    push @arr, "$bud: [[" . $buds->{$bud}->Tag_load_id . "]]<br>";
  }
  my $type = $feat->primary_tag();
  make_new_topic($path, $pa->{PARENTS}->{$type}, 0, \@arr, $BS);
  return;
}

=head2 wiki_update_feature

=cut

sub wiki_update_feature
{
  my ($pa, $BS, $feat, $add, $flag1, $note, $flag2) = @_;
  my $path = $pa->{CHRPATH} . q{/} . $feat->Tag_load_id . ".txt";
  my $text = $flag2 
            ? "See this feature in GBrowse ($pa->{OLDCHROMOSOME})"
            : "See this feature in GBrowse ($pa->{NEWCHROMOSOME})";
  open (my $WH, '>>', "$path") || croak ("CAN'T WORK ON WIKI!");
  if ($flag1)
  {
    print $WH "\n" . $pa->{AUTHSTR};
    if ($BS->{enable_gbrowse})
    {
      print $WH make_link($feat, $text, $pa, $BS);
    }
    print $WH "\n$note" if ($note);
  }
  print $WH "$add" if ($add);
  close $WH;
  return;
}

=head2 update_wiki

=cut

sub update_wiki
{
  my ($BS, $pa, $commentarr) = @_;
  my $VERPATH = $pa->{CHRPATH} . "/$pa->{NEWCHROMOSOME}.txt";
  my @arr = @{$commentarr};
  if ($BS->{enable_gbrowse})
  {
    my $verlink = "http://$BS->{this_server}/cgi-bin/gb2/gbrowse/$pa->{NEWCHROMOSOME}";
    my $href = "<a href=\"$verlink\" target=\"_blank\" style=\"text-decoration:none\">See this version in GBrowse</a>\n";
    unshift @arr, $href;
  }
  unshift @arr, "-- [[Main." . $BS->{wiki_user} . "]] - " . $time{'dd Mon yyyy'} . "\n";
  make_new_topic($VERPATH, "Versions", 0, \@arr, $BS);
  return;
}

=head2 make_new_web

=cut

sub make_new_web
{
  my ($webpath, $linkreplace, $BS) = @_;
  my $now = time;
  my $template = $BS->{wiki_default_web} . q{/};
  $linkreplace = q{} unless $linkreplace;
  my $repl = q{/} . $BS->{wiki_placeholder} . q{/} . $linkreplace . q{/};
  mkdir $webpath;
  system "cp -R $template $webpath";
  opendir(WEB, $webpath);
  my @FILES= readdir(WEB);
  closedir(WEB);
  my $auth = "/ProjectContributor/$BS->{wiki_user}/";
  my $time = "/date=\".+\"/date=\"$now\"/";
	foreach my $name (grep {! -d && $_ !~ m{\A\.}msx} @FILES)
	{
	  my $path = $webpath . q{/} . $name;
	  my $temp = $path . "_tmp";
		system ("sed -e 's$auth' $path >$temp && mv $temp $path");
		system ("sed -e 's$time' $path >$temp && mv $temp $path");
		if ($name eq "WebHome.txt")
		{
		  system ("sed -e 's$repl' $path >$temp && mv $temp $path");
		}
  }
  return;
}

=head2 make_new_topic

=cut

sub make_new_topic
{
  my ($path, $parent, $flag, $arrref, $BS) = @_;
  my $now = time;
  open (my $TOPIC, '>', "$path") || croak ("Can't open $path: $OS_ERROR");
  print $TOPIC "\%META:TOPICINFO{author=\"$BS->{wiki_user}\" comment=\"\"";
  print $TOPIC " date=\"$now\" format=\"1.1\" version=\"1\"}\%\n";
  print $TOPIC "\%META:TOPICPARENT{name=\"$parent\"}\%\n";
  if ($flag)