Return to MPIWGStor.pm CVS log

Up to [Repository] / foxridge-archiver

added silly adobe files to junk file list

#
# Library with definitions and common routines for MPIWG storage system
# scripts
#

package MPIWGStor;

use strict;
use vars qw(@ISA @EXPORT $VERSION
	    $debug %junk_files %index_files $index_file_perm $archived_index_file_perm 
	    $file_perm);
use Exporter;

$VERSION = 0.6.3; #  ROC 6.3.2007

@ISA = qw(Exporter);

@EXPORT = qw($debug %junk_files %index_files $index_file_perm $archived_index_file_perm 
	     $file_perm
	     &parseargs &logger &stime  &s2stime &ymd_date &split_file_path &sstrip 
	     &valid_file_name &valid_dir_name &park_file &unpark_file
             &read_xml &write_xml &add_text_element &create_element_path &create_text_path);

# debug level
$debug = 0;

# junk files
%junk_files = (
    # netatalk stuff
    '.AppleDB' => '.AppleDB',
    '.AppleDesktop' => '.AppleDesktop',
    '.AppleDouble' => '.AppleDouble',
    '.FBCIndex' => '.FBCIndex',
    '.FBCLockFolder' => '.FBCLockFolder',
    ':2eTemporaryItems' => ':2eTemporaryItems',
    ':2eDS_Store' => ':2eDS_Store',
    ':2eBridgeSort' => ':2eBridgeSort',
    # standard appleshare stuff
    '.DS_Store' => '.DS_Store',
    '.TemporaryItems' => '.TemporaryItems',
    'Network Trash Folder' => 'Network Trash Folder',
    'TheVolumeSettingsFolder' => 'TheVolumeSettingsFolder',
    # old appleshare software turds
    '.HSResource' => '.HSResource',
    '.HSancillary' => '.HSancillary',
    '.HSicon' => '.HSicon'
    );

# filenames to not delete (but archive)
%index_files = ( 
		     'index.meta' => 'index.meta',
		     'index.meta.old' => 'index.meta.old'
		     );

# default permissions for normal index files (rw-rw-r--)
$index_file_perm = 0664;
# default permissions for archived index files (rw-r--r--)
$archived_index_file_perm = 0644;
# default permissions for other files (rw-rw-r--)
$file_perm = 0664;


#
# $param_hash = parseargs;
#
# reads @ARGV and returns a hash with all options like "-option=value"
# and the last part of the string as "path"
#
sub parseargs {
    my %opts;
    foreach my $s (@ARGV) {
	if ($s =~ /^-([^=]+)=*(.*)$/) {
	    $opts{$1} = ($2) ? $2 : $1;
	} else {
	    $opts{'path'} = $s;
	}
    }
    return \%opts;
}


#
# logger($level, $message)
#
# logs the $message (mostly to stdout)
#
sub logger {
    my ($level, $message) = @_;
    if ($debug || ($level ne "DEBUG")) {
	print "$level: $message\n";
    }
}

#
# $stime = stime($utime)
#
# format utime (seconds since epoch) into string 
# representation: "YYYY/MM/DD HH:MM:SS"
#
sub stime {
    my ($utime) = @_;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
	localtime($utime);
    my $yy = $year + 1900;
    my $mm = $mon + 1;
    my $stime = sprintf("%d/%02d/%02d %02d:%02d:%02d", 
			$yy, $mm, $mday, $hour, $min, $sec);
    return $stime;
}

#
# $stime = s2stime($stime2)
#
# format db-like time (2003-09-19 12:43:32+02) into string 
# representation: "YYYY/MM/DD HH:MM:SS"
#
sub s2stime {
    my ($s2time) = @_;
    my $stime = "";
    if ($s2time =~ /(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/) {
	my ($year,$mon,$mday,$hour,$min,$sec) = ($1, $2, $3, $4, $5, $6);
	$stime = sprintf("%d/%02d/%02d %02d:%02d:%02d", 
			$year, $mon, $mday, $hour, $min, $sec);
    }
    return $stime;
}

#
# $date = ymd_date($olddate)
#
# converts a date string in mm/dd/yy format to yyyy/mm/dd format
#
sub ymd_date {
    my ($mdy) = @_;
    my $ydm;
    if ($mdy =~ /(\d+)\/(\d+)\/(\d+)/) {
	my $m = $1;
	my $d = $2;
	my $y = $3;
	# extend yy to yyyy
	$y = ($y < 70) ? (2000 + $y) : (($y < 100) ? ($y + 1900) : $y);
	$ydm = sprintf "%d/%02d/%02d", $y, $m, $d;
    }
    return $ydm;
}

#
# ($name, $path) = split_file_path($fn)
#
# splits the file path $fn into
# file name (the last path element) and path
#
sub split_file_path {
    my ($fn, $nodot) = @_;

    if ($fn =~ /^(.*)\/([^\/]+)$/) {
        return ($2, $1);
    } 
    # only file name
    if ($nodot) {
	return ($fn, '');
    } else {
	return ($fn, '.');
    }
}


#
# $name = sstrip($name, $slash)
#
# strips leading and trailing whitespace from $name
# replaces double slashes with single ones with $slash.
#
sub sstrip {
    my ($name, $slash) = @_;
    
    if ($name =~ /^\s*(.*?)\s*$/) {
	$name = $1;
    }
    if ($slash) {
	# trim multiple slashes
	$name =~ s/\/+/\//g;
    }
    return $name;
}


#
# $valid = valid_file_name($name)
#
# checks if $name is a valid file name
#
sub valid_file_name {
    return valid_name($_[0], 0);
}


#
# $valid = valid_dir_name($name)
#
# checks if $name is a valid directory name
#
sub valid_dir_name {
    return valid_name($_[0], 1);
}


#
# $valid = valid_name($name, $mode)
#
# checks if $name is a valid file ($mode=0) or directory name (mode=1)
#
sub valid_name {
    my ($name, $mode) = @_;

    # whitespace?
    if ($name =~ /\s+/) {
	return 0;
    }
    # invalid characters
    if ($name !~ /^[-\w.\/]+$/) {
	return 0;
    }
    # files have extension
    if ($mode == 0) {
	if ($name !~ /\.[-\w]+$/) {
	    return 0;
	}
    }
    return 1;
}


#
# $newfilename = park_file($filename)
#
# parks a file under a new name (*.bak)
#
sub park_file {
    my ($filename) = @_;
    my $newfn = "";
    if (-f $filename) {
	$newfn = "$filename.bak";
	if (! rename $filename, $newfn) {
	    logger("ABORT", "unable to rename file $filename!");
	    exit 1;
	}
    }
    return $newfn;
}
    
#
# $filename = unpark_file($filename)
#
# unparks a file
#
sub unpark_file {
    my ($filename) = @_;
    my $newfn = "$filename.bak";
    if (-f $newfn) {
	if (! rename $newfn, $filename) {
	    logger("ABORT", "unable to rename file $newfn!");
	    exit 1;
	}
	return $filename;
    }
    return "";
}
    


#
# ($document, $rootnode) = read_xml($file)
#
# reads xml meta file $file
# returns root node element
#
sub read_xml {
    my ($file) = @_;
    my $document;

    my $parser = XML::LibXML->new();
    if (! $parser) {
	logger("ABORT", "unable to create parser for metadata index file!!");
	exit 1;
    }

    logger("DEBUG", "index file: $file");
    eval { $document = $parser->parse_file($file) };
    # catch parsing errors
    if ($@) {
	logger("ABORT", "XML syntax error in file $file!!");
	exit 1;
    }
    my $rootnode = $document->documentElement;
    logger("DEBUG", "root element: \'" . $rootnode->nodeName . "\'");

    return ($document, $rootnode);
}


#
# write_xml($document, $file)
#
# saves the XML tree of $document to the file $file
#
sub write_xml {
    my ($document, $filename) = @_;
    # keep backup copy
    if (-f $filename) {
	if (! rename $filename, "$filename.old") {
	    logger("ABORT", "unable to change file $filename!");
	    exit 1;
	}
    }
    # write new file
    my ($fn, $dir) = split_file_path($filename);
    if (-d $dir && $document->toFile($filename)) {
	logger("INFO", "written new file $filename");
	chmod $index_file_perm, $filename;
    } else {
	logger("ABORT", "unable to write file $filename!");
	exit 1;
    }
}

#
# $elem = add_text_element($node, $name, $value, $namespace)
#
# creates an XML element with the name $name and the text content
# $value attached to the node $node and returns it.
#
sub add_text_element {
    my ($node, $name, $value, $namespace) = @_;

    my $doc = $node->ownerDocument;
    my $text = $doc->createTextNode($value);
    my $newnode = $node->addNewChild($namespace, $name);
    $newnode->addChild($text);

    return $newnode;
}

#
# $elem = create_element_path($path, $root, $namespace)
#
# creates and returns a DOM element at the given path from the 
# given root. path is e.g. meta/bib@type=book. elements are separated
# by /, an additional attribute can be specified after the @.
#
sub create_element_path {
    my ($path, $root, $namespace) = @_;
    my $attribute = "";
    # get attribute
    if ($path =~ /^(.+)@(.+)$/) {
	$attribute = $2;
	$path = $1;
    }
    my $point = $root;
    for my $p (split /\//, $path) {
	# check if the next path element exists
	my $n = ($point->findnodes($p))[0];
	if ($n) {
	    $point = $n;
	} else {
	    # create if it doesn't exist
	    $point = $point->addNewChild($namespace, $p);
	}
    }
    # add the attribute
    if ($attribute) {
	my $dom = $root->getOwner();
	my ($attkey, $attval) = split /=/, $attribute; #/ silly fontlock...
	$point->addChild($dom->createAttributeNS($namespace, $attkey, $attval));
    }
    return $point;
}

#
# $elem = create_text_path($path, $text, $root, $namespace)
#
# creates and returns a DOM text element with the given content at the
# given path from the given root.
#
sub create_text_path {
    my ($path, $text, $root, $namespace) = @_;
    my $elem = create_element_path($path, $root, $namespace)->appendTextNode($text);
    return $elem;
}



# module init
return 1;