use strict; use warnings; use Getopt::Long qw/GetOptions/; use LWP; use File::Basename qw/dirname basename/; use File::Copy qw/copy/; my $url ='http://www.google.com/maps/d/u/1/kml?mid=1Oa_egVdStSJBF5C7mpS6MXrkces'; #my $topdir ='/users/NAME/documents/FOLDER'; my $dir ='D:/goodies/pdhuck/down1/perl/monks/kmlbackup'; my $ftype ='zip'; my $debug =0; my %optdef=("debug=i" => \$debug ,"url=s" => \$url ,"dir=i" => \$dir ); GetOptions ( %optdef ) or die("Error in command line arguments\n"); die $dir.' must exist' unless (-d $dir); my $lastdir=$dir.'/last'; # unless (-d $lastdir && -w $lastdir) unless (-d $lastdir) { mustdir ($lastdir); } my $now=time; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =gmtime($now) ; my $nicefmt='/y%04u/m%02u/d%02u-%02u-%02u-%02u-Z'; # last dir is month # my $nicefmt='/y%04u/m%02u/d%02u/%02u-%02u-%02u-Z'; # last dir is day my $nice=sprintf($nicefmt,$year+1900,$mon+1,$mday,$hour,$min,$sec); my $lastfn=$lastdir.'/lastbackup.'.$ftype; my $nextfn=$lastdir.'/nextbackup.'.$ftype; my $ua=LWP::UserAgent->new(agent =>"libwww-perl-kmzbackup"); my $req = new HTTP::Request (GET => $url); my $request = $ua->request ($req); unless ($request->is_success) { die 'get failed for '.$url.' '.$request->status_line;} open (my $nextout,'>',$nextfn) or die 'cant open '.$nextfn; binmode $nextout; print $nextout $request->decoded_content; close $nextout; my $aresame=1; my $compfile='doc.kml'; if (-f $lastfn) { use IO::Uncompress::Unzip qw(unzip $UnzipError) ; use IO::File; my $nextmember = new IO::Uncompress::Unzip($nextfn, Name => $compfile) or die "IO::Uncompress::unzip failed: $UnzipError\n"; my $lastmember = new IO::Uncompress::Unzip($lastfn, Name => $compfile) or die "IO::Uncompress::unzip failed: $UnzipError\n"; while ($aresame && ( my $nextline=<$nextmember>) && (my $lastline=<$lastmember>) ){ unless ($nextline eq $lastline ) {$aresame=0} } if ($aresame && (my $nextline=<$nextmember>) ){ $aresame=0} if ($aresame && (my $lastline=<$lastmember>) ){ $aresame=0} close($nextmember); close($lastmember); } else { $aresame=0;} if ($aresame) { print "No change to file $compfile \n"; unlink $nextfn; exit; } my $endfn=$dir.$nice.'.'.$ftype; my $endfn0=basename($endfn); my $enddir=dirname($endfn); unless (-d $enddir) { mustdir($enddir); } copy($nextfn,$endfn) or die "Copy failed: $!"; print 'new backup:'.$endfn."\n"; copy($nextfn,$lastfn) or die "Copy failed: $!"; unlink $nextfn; exit; sub mustdir { my $dir=shift; return if (-d $dir); my $updir=dirname($dir); mustdir ($updir); mkdir $dir; unless (-d $dir) {die 'cant make dir:'.$dir; } } # mustdir