pg-pull

#!/usr/bin/env perl
################################################################################
# WeBWorK Online Homework Delivery System
# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
# $CVSHeader: webwork2/bin/pg-pull,v 1.3 2007/10/22 20:32:38 sh002i Exp $
# 
# This program is free software; you can redistribute it and/or modify it under
# the terms of either: (a) the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any later
# version, or (b) the "Artistic License" which comes with this package.
# 
# This program 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 either the GNU General Public License or the
# Artistic License for more details.
# 
# Contributed by W.H. Freeman; Bedford, Freeman, and Worth Publishing Group.
################################################################################

# Assemble a new problem library consisting of the specified PG files and any required
# auxiliary files (i.e. images).
# 
# Auxiliary files must be specified in the (unofficial) UsesAuxiliaryFiles(...) tag.
# It is assumed that auxiliary files don't depend on further auxiliary files.
# This will be true <100% of the time.
# 
# Also, right now this script always uses the FIRST textbook entry in generating
# the new file's path and name. Eventually, a --match-text switch will make the
# script useful for files with multiple text tags.

use strict;
use warnings;

use Data::Dumper;
use File::Path;
use File::Spec;
use File::Copy;
use Getopt::Long;
use IO::File;

BEGIN {
	die "WEBWORK_ROOT not found in environment.\n"
		unless exists $ENV{WEBWORK_ROOT};
}

use lib "$ENV{WEBWORK_ROOT}/lib";
use WeBWorK::NPL qw/read_textbooks read_tags/;

my %o;
my %textbooks;
my %seen_paths;

sub main {
	my (@files) = @_;
	my $oldfh = select(STDERR); $|=1; select(STDOUT); $|=1; select($oldfh);
	
	if (defined $o{help}) {
		print usage();
		exit;
	}
	
	my $dest_lib = $o{'dest-lib'};
	# using the last argument as dest-lib is too confusing
	#$dest_lib = pop @files unless defined $dest_lib;
	die "dest-lib not specified.\n" . usage() unless defined $dest_lib;
	
	die "no files specified (perhaps you meant to use --stdin?)\n" . usage()
		unless @files or $o{stdin};
	
	if ($o{'orig-paths'} and not defined $o{'src-lib'}) {
		die "--src-lib must be specified with --orig-paths.\n", usage();
	}
	
	if (defined $o{'src-lib'} and not $o{'orig-paths'}) {
		warn "ignoring --src-lib since --orig-paths was not specified.\n";
	}
	
	if ($o{'orig-paths'}) {
		if (defined $o{textbooks}) {
			warn "ignoring --textbooks since --orig-paths was specified.\n";
		}
	} else {
		if (defined $o{textbooks}) {
			get_texts($o{textbooks});
		} else {
			warn "No Textbooks file specified -- directories will not be named.\n";
		}
	}
	
	my $getfile;
	if ($o{stdin}) {
		$getfile = sub { if (defined ($_=<STDIN>)) { chomp; $_ } else { () } };
	} else {
		my $i = 0;
		$getfile = sub { defined $files[$i] ? $files[$i++] : () };
	}
	
	while (defined (my $file = &$getfile)) {
		#print "file=$file\n";
		process_file($file);
	}
}

sub get_texts {
	my $textbooks = shift;
	my @textbooks;
	
	open my $fh, '<', $textbooks or die "$textbooks: $!\n";
	read_textbooks($fh, \@textbooks);
	close $fh;
	
	foreach my $textbook (@textbooks) {
		$textbooks{$textbook->{'_author'}}{$textbook->{'_title'}}{$textbook->{'_edition'}} = $textbook;
	}
}

sub process_file {
	my $file = shift;
	
	# ignoring volume here because we don't care about w32
	(undef, my ($dir, $name)) = File::Spec->splitpath($file);
	#print "  dir=$dir\n";
	#print "  name=$name\n";
	
	my %tags;
	read_tags($file, \%tags);
	#print Dumper(\%tags);
	
	my ($target_dir_rel, $target_name);
	if ($o{'orig-paths'}) {
		$target_dir_rel = File::Spec->abs2rel($dir, $o{'src-lib'});
		$target_name = $name;
	} else {
		($target_dir_rel, $target_name) = tags_to_path(\%tags, '.pg', $file);
	}
	
	if ($o{'check-names'} and $name ne $target_name) {
		warn "$file: name will be changed to $target_name\n";
	}
	
	my $target_dir = File::Spec->catdir($o{'dest-lib'}, $target_dir_rel);
	
	my @files = ($target_name);
	push @files, @{$tags{UsesAuxiliaryFiles}} if defined $tags{UsesAuxiliaryFiles};
	
	#print "mkpath $target_dir\n" if $o{pretend} or $o{verbose};
	mkpath($target_dir) unless $o{pretend};
	
	foreach my $curr (@files) {
		my $src = File::Spec->catpath(undef, $dir, $curr);
		my $dest = File::Spec->catpath(undef, $target_dir, $curr);
		print "copy $src $dest\n" if $o{pretend} or $o{verbose};
		copy($src, $dest) unless $o{pretend};
	}
}

sub tags_to_path {
	my ($tags, $ext, $file) = @_;
	
	# FIXME here is where we'd put in textbook matching
	my $text = $tags->{textbooks}[0];
	unless (defined $text) {
		warn "$file: no textbook tags\n";
		return;
	}
	my %text = %$text;
	
	if (not defined $text{author}
			or not defined $text{title}
			or not defined $text{edition}
			or not defined $text{chapter}
			or not defined $text{section}
			or not defined $text{problem}
			or @{$text{problem}} == 0) {
		warn "$file: incomplete textbook tags\n";
		return;
	}
	
	my $chapter_name = $text{chapter};
	my $chapsec_name = "$text{chapter}.$text{section}";
	
	if (defined $o{textbooks}) {
		my $text_names = $textbooks{$text{author}}{$text{title}}{$text{edition}};
		if (defined $text_names) {
			my %text_names = %$text_names;

			if (defined $text_names{$text{chapter}}) {
				$chapter_name .= sissy_filename(" $text_names{$text{chapter}}")
			} else {
				warn "$file: no chapter name for $text{chapter}";
			}

			if (defined $text_names{"$text{chapter}.$text{section}"}) {
				$chapsec_name .= sissy_filename(" $text_names{qq|$text{chapter}.$text{section}|}");
			} else {
				warn "$file: no section name for $text{chapter}.$text{section}";
			}
		} else {
			warn "$file: can't find text $text{author}/$text{title}/$text{edition} in Textbooks file -- directories will be unnamed\n";
		}
	}
	
	my $ex_name = "$text{chapter}.$text{section}.$text{problem}[0]";
	$ex_name .= '+' if @{$text{problem}} > 1;
	
	#print "  chapter_name=$chapter_name\n";
	#print "  chapsec_name=$chapsec_name\n";
	#print "  ex_name=$ex_name\n";
	
	# make sure path hasn't been seen before
	my $dir = File::Spec->catdir($chapter_name, $chapsec_name);
	my $partA = $ex_name;
	$partA .= $o{suffix} if defined $o{suffix};
	my $partB = $ext;
	my $uniq = unique_name($dir, $partA, $partB);
	
	#print "  partA=$partA\n";
	#print "  uniq=$uniq\n";
	#print "  partB=$partB\n";
	
	return $dir, "$partA$uniq$partB";
}

sub unique_name {
	my ($dir, $partA, $partB) = @_;
	my $whole = File::Spec->catpath(undef, $dir, "$partA$partB");
	my $uniq = '';
	if (exists $seen_paths{$whole}) {
		my $i = 2;
		do {
			$uniq = "~$i";
			$whole = File::Spec->catpath(undef, $dir, "$partA$uniq$partB");
		} while (exists $seen_paths{$whole});
	}
	$seen_paths{$whole} = ();
	return $uniq;
}

#sub find_macro_file {
#	my ($name, $ref_by) = @_;
#	my (undef,$ref_by_dir,undef) = File::Spec->splitpath($ref_by);
#	my $ref_by_dir_rel = File::Spec->abs2rel($ref_by_dir, $o{'src-lib'});
#	my @dirs = File::Spec->splitdir($ref_by_dir_rel);
#	while (1) {
#		my $dir = File::Spec->catdir(@dirs);
#		my $file = File::Spec->catfile(${'src-lib'}, $dir, $name);
#		return $file if -f $file;
#		pop @dirs;
#	}
#}

sub sissy_filename {
	my $string = shift;
	$string =~ s/:/-/g;
	$string =~ s/[<>\"\/\/|?*]/_/g;
	$string =~ s/\s+/_/g;
	return $string;
}

sub usage {
	return "USAGE:\n"
		. "$0 [OPTIONS] --dest-lib=PATH [--textbooks=PATH] [--suffix=STRING] files...\n"
		. "$0 [OPTIONS] --dest-lib=PATH --orig-paths --src-lib=PATH files...\n"
		. "Options:\n"
		. "\t--stdin\n"
		. "\t--pretend\n"
		. "\t--verbose\n"
		. "\t--check-names\n"
		;
}

GetOptions(\%o,
	'textbooks=s',
	'dest-lib=s',
	'orig-paths',
	'src-lib=s',
	'stdin',
	'suffix=s',
	'pretend',
	'verbose',
	'check-names',
	'help',
);
main(@ARGV);