Return to renamefile.pl CVS log

Up to [Local Repository] / db / prgsrc

Annotation of db/prgsrc/renamefile.pl, revision 1.1

1.1     ! boris       1: #!/usr/local/bin/perl -w
        !             2: 
        !             3: =head1 NAME
        !             4: 
        !             5: renamefile.pl - renaming file in database
        !             6: 
        !             7: =head1 SYNOPSIS
        !             8: 
        !             9: renamefile.pl  I<source> I<target>
        !            10: 
        !            11: 
        !            12: =head1 DESCRIPTION
        !            13: 
        !            14: The script will rename source to target in the database
        !            15: 
        !            16: 
        !            17: 
        !            18: =head1 BUGS
        !            19: 
        !            20: The database, user and password are hardcoded. 
        !            21: 
        !            22: =head1 SEE ALSO
        !            23: 
        !            24: createindex.pl(1), updatedb.pl(1), updateindex.pl(1), deletefiles.pl(1)
        !            25: 
        !            26: =head1 AUTHOR
        !            27: 
        !            28: Boris Veytsman
        !            29: 
        !            30: =head1 $Id: deletefiles.pl,v 1.3 2001/07/28 21:19:06 boris Exp $
        !            31: 
        !            32: =cut
        !            33: 
        !            34:     use strict;
        !            35: 
        !            36: use DBI;
        !            37: 
        !            38: MAIN: 
        !            39: {
        !            40:     my $USAGE="Usage: renamefile.pl source target\n";
        !            41:     if (scalar @ARGV <=> 2) {
        !            42:        die $USAGE;
        !            43:     }
        !            44:     my($dbh) = DBI->connect("DBI:mysql:chgk", "piataev", "") 
        !            45:        or die "Can't connect to DB chgk\n";
        !            46: 
        !            47:     my ($source,$target)=@ARGV;
        !            48:     my $sth=$dbh->prepare("
        !            49:          select Title from Tournaments where
        !            50:          Type='þ' and FileName='$source'");
        !            51:     $sth->execute;
        !            52:     if(!$sth->rows) {
        !            53:        print STDERR "There is no file $source in the database\n";
        !            54:        exit 1;
        !            55:     }
        !            56:     my ($Title)=$sth->fetchrow;
        !            57:     $sth=$dbh->prepare("
        !            58:          select Title from Tournaments where
        !            59:          Type='þ' and FileName='$target'");
        !            60:     $sth->execute;
        !            61:     if($sth->rows) {
        !            62:        ($Title)=$sth->fetchrow;
        !            63:        print STDERR "The file $source already exists. The title is $Title\n";
        !            64:        exit 1;
        !            65:     }
        !            66:     
        !            67:     $sth=$dbh->prepare("
        !            68:        update Tournaments set FileName='$target' where Filename='$source'");
        !            69:     $sth->execute;
        !            70:     
        !            71:     $dbh->disconnect;
        !            72:     exit 0;
        !            73: }
        !            74: