1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5 use Log::Log4perl qw(:easy);
6 use Getopt::Long qw(GetOptions);
7
8 my $log_file = "gsgd.log";
9 sub get_log_name { return $log_file; };
10 my $log_conf = q(
11 log4perl.rootLogger = INFO, LOG1, screen
12 log4perl.appender.LOG1 = Log::Log4perl::Appender::File
13 log4perl.appender.LOG1.filename = sub { get_log_name(); }
14 log4perl.appender.LOG1.mode = append
15 log4perl.appender.LOG1.layout = Log::Log4perl::Layout::PatternLayout
16 log4perl.appender.LOG1.layout.ConversionPattern = %d %p >> %m %n
17
18 log4perl.appender.screen = Log::Log4perl::Appender::Screen
19 log4perl.appender.screen.stderr = 0
20 log4perl.appender.screen.layout = PatternLayout
21 log4perl.appender.screen.layout.ConversionPattern = %d %p >> %m %n
22 );
23
24 Log::Log4perl::init(\$log_conf);
25 my $logger = get_logger();
26
27 my %args;
28 GetOptions(
29 \%args,
30 'gsg-cmd=s',
31 'comms-file=s'
32 );
33
34 my $comm_file = "talk.gsgd";
35 my $LOCK_FILE = "lock.gsgd";
36 my $regen_cmd;
37
38 sub process_args() {
39
40 if ( ! defined $args{'gsg-cmd'} || $args{'gsg-cmd'} eq "" ) {
41 $logger->error("Must pass --gsg-cmd");
42 exit 1;
43 }
44
45 $regen_cmd = $args{'gsg-cmd'};
46
47 if ( defined $args{'comms-file'} ) {
48 if ( ! -f $args{'comms-file'} ) {
49 $logger->error("$args{'comms-file'} doesn't look like a regular file");
50 exit 1;
51 }
52
53 if ( ! -w $args{'comms-file'} ) {
54 $logger->error("$0 doesn't appear to have permission to write to $args{'comms-file'}");
55 exit 1;
56 }
57
58 $comm_file = $args{'comms-file'};
59 }
60
61 }
62
63 process_args();
64
65 sub create_lock() {
66
67 $logger->debug("Creating lock file while operating");
68 open(my $fh, ">", $LOCK_FILE) or die $logger->error("Couldn't create $LOCK_FILE");
69 print $fh "";
70 close $fh;
71
72 }
73
74 sub remove_lock() {
75
76 $logger->debug("Removing lock file, not operating");
77 unlink($LOCK_FILE) or die $logger->error("Couldn't unlink $LOCK_FILE");
78
79 }
80
81 sub check_lock() {
82
83 if ( -f $LOCK_FILE ) {
84 $logger->info("Found lock file");
85 sleeper(5);
86 if ( -f $LOCK_FILE ) {
87 die $logger->error("$LOCK_FILE still exists even after waiting, why?");
88 }
89 }
90
91 }
92
93
94 sub remove_instruction($) {
95
96 my $instruction_to_remove = shift;
97
98 $logger->debug("Removing $instruction_to_remove instruction");
99 $logger->debug("Opening $comm_file for writing");
100 open(my $fh, ">", $comm_file);
101 my @lines = $fh;
102 foreach my $line ( @lines ) {
103 # This is bad TODO
104 print $fh "$line\n" unless ( $line =~ m/$instruction_to_remove/ || $line =~ m/GLOB/);
105 }
106 $logger->debug("Closing $comm_file");
107 close $fh;
108
109 }
110
111 sub regen() {
112
113 $logger->info("Regening site");
114 system("$regen_cmd") == 0
115 or die $logger->error("Failed to exec $regen_cmd !");
116 check_lock();
117 create_lock();
118 remove_instruction("Regen");
119 remove_lock();
120
121 }
122
123 sub gsgd_exit() {
124
125 check_lock();
126 create_lock();
127 remove_instruction("Exit");
128 remove_lock();
129 exit 0;
130
131 }
132
133 sub sleeper($) {
134
135 my $sleep_time = shift;
136 $logger->debug("Sleeping $sleep_time seconds");
137 sleep $sleep_time;
138
139 }
140
141 sub open_comms() {
142
143 $logger->debug("Opening $comm_file for reading");
144 open(my $fh, "<", $comm_file) or die $logger->error("Could not open $comm_file for reading");
145 my @instructions = <$fh>;
146 $logger->debug("Closing $comm_file");
147 close $fh;
148
149 foreach my $line ( @instructions ) {
150 chomp $line;
151 if ( $line =~ m/^Regen$/ ) {
152 $logger->info("Got $line instruction");
153 regen();
154 } elsif ( $line =~ m/^Exit$/ ) {
155 $logger->info("Got $line instruction");
156 gsgd_exit();
157 } else {
158 $logger->error("Unrecognized instruction $line");
159 }
160 }
161
162 }
163
164 $logger->info("Starting");
165 while() {
166
167 sleeper(1);
168 open_comms();
169
170 }