File: setup_trac.pl

package info (click to toggle)
libnet-trac-perl 0.16-3
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 316 kB
  • sloc: perl: 2,855; makefile: 2
file content (147 lines) | stat: -rw-r--r-- 3,199 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
#!/usr/bin/perl

package Net::Trac::TestHarness;
use warnings;
use strict;

use Test::More;
use File::Temp qw/tempdir/;
use LWP::Simple qw/get/;
use Time::HiRes qw/usleep/;

#my $x = __PACKAGE__->new(); $x->start_test_server(); warn $x->url; sleep 999;
sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    return $self;
}

sub init_test_server {
    my $self = shift;
    $self->port( int( 60000 + rand(2000) ) );
    $self->dir( tempdir( CLEANUP => 1 ) );
    $self->init;

    if (@_) {
        open my $fh, '>>',
          File::Spec->catfile( $self->dir, 'trac', 'conf', 'trac.ini' )
          or die $!;
        print $fh @_;
    }
    return 1;
}

sub start_test_server {
    my $self = shift;
    $self->init_test_server(@_);
    $self->daemonize;
    return $self->_did_server_start;
}

sub _did_server_start {
    my $self = shift;
    for ( 1 .. 200 ) {
        return 1 if eval { get( $self->url ) };
        usleep 15000;
    }
    die "Server didn't start";
}

sub port {
    my $self = shift;
    if (@_) {
        $self->{_port} = shift;
    }
    return $self->{_port};
}

sub dir {
    my $self = shift;
    if (@_) {
        $self->{_dir} = shift;
    }
    return $self->{_dir};
}

sub pid {
    my $self = shift;
    if (@_) {
        $self->{_pid} = shift;
    }
    return $self->{_pid};
}

sub url {
    my $self = shift;
    if (@_) {
        $self->{_url} = shift;
    }
    return $self->{_url};
}

sub init {
    my $self = shift;
    my $dir  = $self->dir;
    my $port = $self->port;
    open( my $sys,
        "trac-admin $dir/trac initenv proj sqlite:db/trac.db svn ''|" );
    my @content = <$sys>;
    my ($url) = grep { defined $_ }
        map { /Then point your browser to (.*)\./ ? $1 : undef } @content;
    close($sys);
    $url =~ s/8000/$port/;
    $self->url($url);

    $self->_grant_hiro();

}

sub _grant_hiro {
    my $self = shift;
    my $dir = $self->dir;
open (my $sysadm, "trac-admin $dir/trac permission add hiro TRAC_ADMIN|");
my @results = <$sysadm>;
close ($sysadm);

open(my $htpasswd, ">$dir/trac/conf/htpasswd") || die $!;
# hiro / yatta
print $htpasswd "hiro:trac:98aef54bbd280226ac74b6bc500ff70e\n";
close $htpasswd;

};


sub kill_trac {
    my $self = shift;
    return unless $self->pid;
    kill 1, $self->pid;

}
           sub daemonize {
               my $self = shift;
               my $dir = $self->dir;
               my $port = $self->port;
               my $old_dir = `pwd`;
                chomp $old_dir;
               chdir $dir."/trac";
               open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
                 open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
               defined(my $pid = fork) or die "Can't fork: $!";
               if ( $pid ) {
                   $self->pid($pid);
                    chdir($old_dir);
                return $pid;
               } else {
                   open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
               exec("tracd -p $port -a trac,$dir/trac/conf/htpasswd,trac $dir/trac") || die "Tracd";
           }
           }


sub DESTROY {
    my $self = shift;
    $self->kill_trac;
}

           1;