XML_ID.pm
- package XML_ID;
- use strict;
- use File::Path;
- use File::Basename;
- sub getIDFilefromID
- {
- my ($id, $tmp, $idFile, $DATABASE_DIRECTORY);
- $DATABASE_DIRECTORY = '/Zvon/FileCentral';
-
- $id = $_[0];
- $idFile = $id;
- $idFile =~s/\D*(\d{4})(\d{2})(\d{2}).*/$1\/$2\/$3.x/;
- $idFile =~ s/(\d{4})(\d{2}).*/$DATABASE_DIRECTORY\/$1\/$2\/$3.x/;
- $idFile = "$DATABASE_DIRECTORY/$idFile";
- return $idFile;
- }
- #returns true, if the database contains a id, which leads to other URL then
- #the one given in the database
- sub existFileWithSameID
- {
- my ($id, $tmp, $idFile, $href,$first, $last);
- $id = $_[0];
- $href = $_[1];
- $idFile = getIDFilefromID($id);
-
- if(!(open IN, $idFile)){return 0;}
- read IN, $tmp, 1000000;
- close IN;
-
- $first = index($tmp,$id);
- if($first == -1) {return 0;}
- $last = rindex($tmp,$id);
- if ($first != $last) {print "\n\n$idFile \ncontains several occurences of $id.\nProgram was terminated\n\n";exit;}
-
- $first = index($tmp,"=",$first)+1;
- $last = index($tmp,"\n",$first);
- $tmp = substr($tmp,$first,$last-$first);
-
- if (uc($tmp)eq uc($href))
- {
- if ($tmp ne $href)
- {
- print "\nFor $id \nDifference in URL only in case\nin database:$tmp\nin file: $href. \n\nFailed.";exit;
- }
- return 0;
- }
- return 1;
- }
- sub insertInDatabase
- {
- my ($id, $dir, $idFile, $href, $tmp);
- $id = $_[0];
- $href = $_[1];
- $idFile = getIDFilefromID($id);
- $dir = dirname($idFile);
- if(!(-d $dir)) {mkpath($dir,"true");};
- if(open IN, $idFile)
- {
- read IN, $tmp, 1000000;
- close IN;
- if ($tmp=~/$id/) {return;}
- }
- open OUT,">>$idFile";
- print OUT "$id=$href\n";
- close OUT;
-
- }
- sub getHREFfromID
- {
- my ($id, $idFile, $href, $tmp);
- $id = $_[0];
- $idFile = getIDFilefromID($id);
-
- if(!(open IN, $idFile)) {"print $id not in database";return}
- read IN, $tmp, 1000000;
- close IN;
-
- $tmp =~ /$id.*/;
- $href = $&;
- $href =~ s/$id=(.*)/$1/;
- return $href;
- }
- 1