#!/usr/bin/perl
use strict;
push(@INC,'/home/oc/cgi-bin/');
use lib '/home/oc/cgi-bin/';
use OC;
use CGI qw/:standard/;
use CGI::Carp qw(fatalsToBrowser);
use HTML::Template;
use Tie::IxHash;
use Digest::MD5 qw(md5_hex);
use Mail::Sender;
use vars qw/
%CONFIG
$template
%form
%cookie
$self_url
@NOTE
$BODY
/;
sub ConnectToDatabase {
if (!defined $::db) {
$::db = DBI->connect("DBI:mysql:$CONFIG{db_name}:$CONFIG{db_host}:
$CONFIG{db_port}",$CONFIG{db_username},$CONFIG{db_password})
|| die "Can't connect to database server: $CONFIG{db_name} $CONFIG{db_host} $CONFIG{db_port}";
}
return $::db;
}
sub PrepareSQL {
my ($str) = (@_);
$::sth_cvslinks=$::db->prepare($str);
}
sub ExecuteSQL {
$::sth_cvslinks->execute(@_) || die "Could not execute SQL statement";
}
sub SendSQL {
PrepareSQL(@_);
ExecuteSQL();
}
sub FetchSQLData {
return $::sth_cvslinks->fetchrow_array();
}
sub Note {
push(@NOTE,$_[0]);
}
sub Initialize {
%form=();
my $query=new CGI;
foreach ($query->param) {
$form{$_}=$query->param($_);
}
foreach ($query->cookie) {
$cookie{$_}=$query->cookie($_);
}
%CONFIG=%OC::CONFIG;
$CONFIG{cvslinks_url}='/cgi-bin/cvslinks.cgi';
$CONFIG{cvslinks_script}='/home/oc/cgi-bin/cvslinks.cgi';
$CONFIG{cvslinks_lock_file}='/tmp/cvslinks-update.running';
$self_url=$CONFIG{cvslinks_url};
@NOTE=();
$BODY='';
}
sub Add_Link {
my ($target,$link,$db_only)=@_;
foreach ($target,$link) {
$_=~s!/$!!is;
}
unless ($target=~m!^/!) {
my $start=substr($link,0,rindex($link,'/')+1);
$target=OC::Finalize_Path("$start$target");
}
my $ext='';
if (OC::File_Type($target)==undef || $target eq '') {
if (OC::File_Type("$target,v")==undef || $target eq '') {
push(@NOTE,"Target doesn't exist: $target");
return;
} else {
$ext=',v';
}
}
if (OC::File_Type("$link$ext")==undef) {
my $result=`ln -v -s $target$ext $link$ext`;
unless ($result=~m!^create symbolic link!) {
push(@NOTE,"Error: $result");
return;
}
} else {
unless ($db_only) {
push(@NOTE,"File already exists: $link$ext");
return;
}
}
SendSQL("select link from cvslinks where link='$link'");
unless (FetchSQLData) {
SendSQL("insert into cvslinks (target,link) values ('$target','$link')");
push(@NOTE,"Link successfully created.");
OC::Log("$cookie{username} - $link (target: $target)");
} else {
push(@NOTE,"Error: link already exist");
}
}
sub Delete_Link {
my ($link)=@_;
my $target=OC::Target($link);
foreach ($target,$link) {
$_=~s!/$!!is;
}
if ($target ne $link) {
if (OC::File_Type($link)!=undef) {
my $result=`rm $link`;
if ($result ne '') {
push(@NOTE,"Error: $result");
return;
}
}
OC::Log("$cookie{username} - $link (target: $target)");
SendSQL("delete from cvslinks where link='$link'");
push(@NOTE,"Link successfully deleted.");
} else {
push(@NOTE,"Error: $target is not a link");
}
}
sub Complete {
OC::Log("complete update started");
if (defined OC::File_Type("$CONFIG{cvslinks_lock_file}")) {
return;
}
`touch $CONFIG{cvslinks_lock_file}`;
SendSQL("delete from cvslinks");
my @list=("$CONFIG{cvsroot}/*");
while (@list) {
my $element=pop(@list);
my ($folders,$files)=OC::List($element);
foreach my $name (@{$folders},@{$files}) {
$name=OC::Finalize_Path($name);
my $target=OC::Target($name);
if ($name ne $target) {
Add_Link($target,$name,1);
} elsif (OC::File_Type($name)==$OC::_FOLDER) {
# print "$name\n";
push(@list,"$name/*");
}
}
}
`rm $CONFIG{cvslinks_lock_file}`;
OC::Log("complete update finished");
}
sub Display_Table {
my @table=();
my %row=();
SendSQL("select id,target,link from cvslinks");
while (my @result=FetchSQLData) {
$row{$result[1]}{$result[0]}=$result[2];
}
my ($color1,$color2)=($CONFIG{color}{table2},$CONFIG{color}{table3});
foreach my $target (keys %row) {
my $rowspan=scalar(keys %{$row{$target}});
my @links=();
foreach my $id (keys %{$row{$target}}) {
($color1,$color2)=($color2,$color1);
my $link=$row{$target}{$id};
$link=~s!$CONFIG{cvsroot}!!is;
if (OC::File_Type($target)==$OC::_FOLDER) {
$link=OC::Finalize_Path("$link/");
} else {
$link=~s!,v$!!is;
}
my %entry=();
$entry{link}=$link;
$entry{link_link}="$CONFIG{cvsweb_url}/$link";
$entry{del_link}="$self_url?cmd=del&id=$id";
$entry{color}=$color1;
push(@links,\%entry);
}
if (OC::File_Type($target)==$OC::_FOLDER) {
$target=OC::Finalize_Path("$target/");
} else {
$target=~s!,v$!!is;
}
$target=~s!$CONFIG{cvsroot}!!is;
my %entry=();
$entry{links}=\@links;
$entry{target}=$target;
$entry{target_link}="$CONFIG{cvsweb_url}/$target";
$entry{color}=$color1;
$entry{rowspan}=$rowspan;
push(@table,\%entry);
}
$template->param(table=>\@table);
}
sub Web_Mode {
print header(-type => 'text/html',-charset=>'');
$template=HTML::Template->new(
filename=>$CONFIG{tmpl_cvslinks_file},
die_on_bad_params=>0,
loop_context_vars=>1,
global_vars=>0,
shared_cache=>0,
);
if ($form{cmd} eq 'complete') {
Complete;
}
my ($cp,$atype)=OC::Login($cookie{username},$cookie{password});
if ($atype eq 'project' || $atype eq 'admin') {
$template->param(logged_in=>1);
if ($form{cmd} eq 'add') {
my $link=OC::Finalize_Path("$CONFIG{cvsroot}/$form{link}");
my $target=OC::Finalize_Path("$CONFIG{cvsroot}/$form{target}");
if ($link ne $CONFIG{cvsroot} && $target ne $CONFIG{cvsroot}
&& $link=~m/^$CONFIG{cvsroot}/ && $target=~m/^$CONFIG{cvsroot}/ ) {
Add_Link($target,$link);
} else {
push(@NOTE,"Invalid link or target!");
}
} elsif ($form{cmd} eq 'del') {
SendSQL("select link from cvslinks where id=$form{id}");
my $link=FetchSQLData;
if ($link ne '') {
Delete_Link($link);
} else {
push(@NOTE,"Invalid link id: $form{id}");
}
} elsif ($form{cmd} eq 'update') {
my $ps=`ps ax`;
unless (defined OC::File_Type("$CONFIG{cvslinks_lock_file}")) {
OC::Log("should run complete update");
`lynx -source http://www.opencores.org/$CONFIG{cvslinks_url}?cmd=complete &`;
} else {
push(@NOTE,"Update process already running..");
}
} Display_Table;
my @notes=();
foreach (@NOTE) {
my %row=();
$row{note}=$_;
push(@notes,\%row);
}
$template->param(
notes=>\@notes,
color0=>$CONFIG{color}{bg0},
color1=>$CONFIG{color}{table1},
color2=>$CONFIG{color}{table2},
color3=>$CONFIG{color}{table3},
no_panel=>1,
cvsweb_url=>"$CONFIG{cvsweb_url}/",
update_link=>"$self_url?cmd=update",
);
}
print $template->output;
}
sub Main {
Initialize;
ConnectToDatabase;
if ($ENV{REQUEST_URI} ne '') {
Web_Mode;
} else {
Complete;
foreach (@NOTE) {
print "$_\n";
}
}
}
Main;