/usr/share/perl5/AMC/State.pm is in auto-multiple-choice-common 1.2.1-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 | # -*- perl -*-
#
# Copyright (C) 2011 Alexis Bienvenue <paamc@passoire.fr>
#
# This file is part of Auto-Multiple-Choice
#
# Auto-Multiple-Choice is free software: you can redistribute it
# and/or modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation, either version 2 of
# the License, or (at your option) any later version.
#
# Auto-Multiple-Choice is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Auto-Multiple-Choice. If not, see
# <http://www.gnu.org/licenses/>.
package AMC::State;
# This package helps storing state of important files after the user
# has printed exam sheets. All requested files are stored in a archive
# file, along with MD5 sum of each of these files and printing
# information. When printing again, if all the files are unchanged,
# only printing information is added. If some of the files has been
# modified since the last print, a new ARCHIVE file is created.
use AMC::Basic;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use Digest::MD5;
use XML::Simple;
sub new {
my (%o)=(@_);
my $self={'directory'=>'',
'archivefile'=>'', # absolute
'descfile'=>'state.xml',
};
for my $k (keys %o) {
$self->{$k}=$o{$k} if(defined($self->{$k}));
}
$self->{'archive'}=Archive::Zip->new();
$self->{'data'}={};
$self->{'directory'} =~ s/\/$//;
bless $self;
return($self);
}
sub archive {
my ($self)=@_;
return($self->{'archive'});
}
# reads the ARCHIVE file. If no filename is given, looks for the last ARCHIVE
# file created in given directory.
sub read {
my ($self,$archivefile)=@_;
if(!$archivefile) {
$archivefile=$self->{'archivefile'};
}
if(!$archivefile) {
# look for the last one in the directory
opendir(my $dh, $self->{'directory'})
or debug "Error opening directory $directory: $!";
my @st = sort { $b cmp $a }
grep { /^saved-[0-9-]+\.zip$/ && -f $self->{'directory'}."/$_" } readdir($dh);
closedir $dh;
if(@st) {
debug "Archive file found: $st[0]";
$archivefile=$self->{'directory'}."/".$st[0];
} else {
debug "No ARCHIVE file";
$archivefile='';
}
}
$self->{'data'}={'md5'=>{},'print'=>[]};
if(-f $archivefile) {
# opens the ARCHIVE file to look at the content
debug "Reading ARCHIVE $archivefile";
if( $self->{'archive'}->read($archivefile) != AZ_OK ) {
debug "Error reading $archivefile";
} else {
# look for XML description file, with MD5 sums and
# printing information, and read it
my $xml = $self->{'archive'}->contents($self->{'descfile'});
if($xml) {
$self->{'data'}=XMLin($xml,ForceArray => 1,ContentKey=>'content',KeyAttr =>['file']);
$self->{'archivefile'}=$archivefile;
}
}
} else {
debug "No file $archivefile";
$self->{'archivefile'}='';
}
}
# writes ARCHIVE file to disk, including XML file with MD5 sums and
# printing information
sub write {
my ($self,$archivefile)=@_;
if($archivefile) {
$self->{'archivefile'}=$archivefile;
} else {
$archivefile=$self->{'archivefile'};
}
if(!$archivefile) {
# if no filename is given, create it from date and time
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
$archivefile=$self->{'directory'}."/".
sprintf("saved-%d-%02d-%02d-%02d-%02d-%02d.zip",
$year+1900,$mon+1,$mday,$hour,$min,$sec);
$self->{'archivefile'}=$archivefile;
}
# adds XML file to ARCHIVE
my $xml=XMLout(
$self->{'data'},
ContentKey=>'content',KeyAttr =>['file'],
RootName=>'state',
);
$self->{'archive'}->removeMember($self->{'descfile'});
$self->{'archive'}->addString($xml,$self->{'descfile'});
# writes to disk
debug "Writing ARCHIVE to $archivefile ...";
unless ( $self->{'archive'}->overwriteAs($archivefile) == AZ_OK ) {
debug "Error writing to $archivefile";
}
}
# adds printing information
sub add_print {
my ($self,%oo)=@_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
push @{$self->{'data'}->{'print'}},{%oo,'date'=>sprintf("%d-%02d-%02d %02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec)};
}
# clears all MD5 sums from current state
sub clear_md5 {
my ($self)=@_;
$self->{'data'}->{'md5'}={};
}
# returns MD5 sum stocked in the ARCHIVE state for a given file
sub get_md5 {
my ($self,$file)=@_;
my $r=$self->{'data'}->{'md5'}->{$file}->{'content'};
return(defined($r) ? $r : '');
}
# sets MD5 sum in current state
sub set_md5 {
my ($self,$file,$sum)=@_;
$self->{'data'}->{'md5'}->{$file}->{'content'}=$sum;
}
# check if given files are all unchanged
sub check_local_md5 {
my ($self,@files)=@_;
my $ok=1;
FILE:for(@files) {
if(!$self->check_md5($_)) {
$ok=0;
last FILE;
}
}
return($ok);
}
# check if given file is unchanged. $localfile is the absolute path of
# the on-disk file, and $file is the name of the in-ARCHIVE file. Un empty
# $localfile is set to file $file in state directory (given when using
# new)
sub check_md5 {
my ($self,$file,$localfile)=@_;
if(!$localfile) {
if($file =~ /^\//) {
$localfile=$file;
$file =~ s/.*\///;
} else {
$localfile=$self->{'directory'}."/".$file;
}
}
my $z=$self->get_md5($file);
debug "Archive MD5: $z";
if($z) {
if(open(FILE, $localfile)) {
binmode(FILE);
my $md5_local=Digest::MD5->new->addfile(*FILE)->hexdigest;
close(FILE);
debug "Local MD5: $md5_local";
return($z eq $md5_local);
} else {
debug "Open failed for $localfile";
return(0);
}
} else {
debug "No ARCHIVE MD5 for $file";
return(0);
}
}
# adds MD5 sum of given on-disk file to current state
sub add_md5 {
my ($self,$file,$localfile)=@_;
if(!$localfile) {
if($file =~ /^\//) {
$localfile=$file;
$file =~ s/.*\///;
} else {
$localfile=$self->{'directory'}."/".$file;
}
}
if(open(FILE, $localfile)) {
binmode(FILE);
my $md5_local=Digest::MD5->new->addfile(*FILE)->hexdigest;
close(FILE);
debug "Adding MD5: $md5_local";
$self->set_md5($file,$md5_local);
} else {
debug "Open failed for $localfile";
}
}
# adds file to ARCHIVE and sets corresponding MD5 sum in current state
sub add_file {
my ($self,$file,$localfile)=@_;
if(!$localfile) {
if($file =~ /^\//) {
$localfile=$file;
$file =~ s/.*\///;
} else {
$localfile=$self->{'directory'}."/".$file;
}
}
if(-f $localfile) {
debug "Adding $localfile [$file]...";
if($self->{'archive'}->addFile($localfile,$file)) {
$self->add_md5($file,$localfile);
debug "OK.";
return(1);
} else {
debug "Error adding $localfile : $!";
return(0);
}
} else {
debug "ARCHIVE: No file $localfile";
return(0);
}
}
# adds a list of files all in the state sirectory
sub add_local_files {
my ($self,@files)=@_;
my $i=0;
for(@files) { $i+=$self->add_file($_); }
return($i);
}
1;
|